prep_ideal_case.f90

!                                          
  CALL GET_SIZEX_LB(CLUOUT,NIMAX_ll,NJMAX_ll,NRIMX,   &
       IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU,         &
       IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
  NSIZELBY_ll=0
  NSIZELBYV_ll=0
  NSIZELBYTKE_ll=0
  NSIZELBYR_ll=0
  NSIZELBYSV_ll=0
  ALLOCATE(XLBYUM(0,0,0))
  ALLOCATE(XLBYVM(0,0,0))
  ALLOCATE(XLBYWM(0,0,0))
  ALLOCATE(XLBYTHM(0,0,0))
  ALLOCATE(XLBYTKEM(0,0,0))
  ALLOCATE(XLBYRM(0,0,0,0))
  ALLOCATE(XLBYSVM(0,0,0,0))
  !
  IF ( LHORELAX_UVWTH ) THEN
!JUAN A REVOIR TODO_JPHEXT
! <<<<<<< prep_ideal_case.f90
    ! NSIZELBX_ll=2*NRIMX+2
    ! NSIZELBXU_ll=2*NRIMX+2
    ALLOCATE(XLBXUM(IISIZEXFU,NJU,NKU))
    ALLOCATE(XLBXVM(IISIZEXF,NJU,NKU))
    ALLOCATE(XLBXWM(IISIZEXF,NJU,NKU))
    ALLOCATE(XLBXTHM(IISIZEXF,NJU,NKU))
! =======
    NSIZELBX_ll=2*NRIMX+2*JPHEXT
    NSIZELBXU_ll=2*NRIMX+2*JPHEXT
    ! ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,NJU,NKU))
    ! ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,NJU,NKU))
    ! ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,NJU,NKU))
    ! ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,NJU,NKU))
! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
  ELSE
    NSIZELBX_ll= 2*JPHEXT     ! 2
    NSIZELBXU_ll=2*(JPHEXT+1) ! 4 
    ALLOCATE(XLBXUM(NSIZELBXU_ll,NJU,NKU))
    ALLOCATE(XLBXVM(NSIZELBX_ll,NJU,NKU))
    ALLOCATE(XLBXWM(NSIZELBX_ll,NJU,NKU))
    ALLOCATE(XLBXTHM(NSIZELBX_ll,NJU,NKU))
  END IF  
  !
  IF ( NRR > 0 ) THEN
    IF (       LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI    &
          .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH                     &
       ) THEN 
!JUAN A REVOIR TODO_JPHEXT
! <<<<<<< prep_ideal_case.f90
      ! NSIZELBXR_ll=2* NRIMX+2
      ALLOCATE(XLBXRM(IISIZEXF,NJU,NKU,NRR))
! =======
      NSIZELBXR_ll=2*NRIMX+2*JPHEXT
      ! ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,NJU,NKU,NRR))
! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
    ELSE
      NSIZELBXR_ll=2*JPHEXT ! 2
      ALLOCATE(XLBXRM(NSIZELBXR_ll,NJU,NKU,NRR))
    ENDIF
  ELSE
    NSIZELBXR_ll=0
    ALLOCATE(XLBXRM(0,0,0,0))
  END IF
  !
  IF ( NSV > 0 ) THEN 
    IF ( ANY( LHORELAX_SV(:)) ) THEN
!JUAN A REVOIR TODO_JPHEXT
! <<<<<<< prep_ideal_case.f90
      ! NSIZELBXSV_ll=2* NRIMX+2
      ALLOCATE(XLBXSVM(IISIZEXF,NJU,NKU,NSV))
! =======
      NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
      ! ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,NJU,NKU,NSV))
! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
    ELSE
      NSIZELBXSV_ll=2*JPHEXT ! 2
      ALLOCATE(XLBXSVM(NSIZELBXSV_ll,NJU,NKU,NSV))
    END IF
  ELSE
    NSIZELBXSV_ll=0
    ALLOCATE(XLBXSVM(0,0,0,0))
  END IF
!
ELSE                                   ! 3D case
!
  CALL GET_SIZEX_LB(CLUOUT,NIMAX_ll,NJMAX_ll,NRIMX,   &
       IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU,         &
       IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
  CALL GET_SIZEY_LB(CLUOUT,NIMAX_ll,NJMAX_ll,NRIMY,   &
       IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV,         &
       IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2)
!
  IF ( LHORELAX_UVWTH ) THEN
    NSIZELBX_ll=2*NRIMX+2*JPHEXT
    NSIZELBXU_ll=2*NRIMX+2*JPHEXT
    NSIZELBY_ll=2*NRIMY+2*JPHEXT
    NSIZELBYV_ll=2*NRIMY+2*JPHEXT
    ALLOCATE(XLBXUM(IISIZEXFU,IJSIZEXFU,NKU))
    ALLOCATE(XLBYUM(IISIZEYF,IJSIZEYF,NKU))
    ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,NKU))
    ALLOCATE(XLBYVM(IISIZEYFV,IJSIZEYFV,NKU))
    ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,NKU))
    ALLOCATE(XLBYWM(IISIZEYF,IJSIZEYF,NKU))
    ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,NKU))
    ALLOCATE(XLBYTHM(IISIZEYF,IJSIZEYF,NKU))
  ELSE
    NSIZELBX_ll=2*JPHEXT      ! 2
    NSIZELBXU_ll=2*(JPHEXT+1) ! 4
    NSIZELBY_ll=2*JPHEXT      ! 2
    NSIZELBYV_ll=2*(JPHEXT+1) ! 4
    ALLOCATE(XLBXUM(IISIZEX4,IJSIZEX4,NKU))
    ALLOCATE(XLBYUM(IISIZEY2,IJSIZEY2,NKU))
    ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,NKU))
    ALLOCATE(XLBYVM(IISIZEY4,IJSIZEY4,NKU))
    ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,NKU))
    ALLOCATE(XLBYWM(IISIZEY2,IJSIZEY2,NKU))
    ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,NKU))
    ALLOCATE(XLBYTHM(IISIZEY2,IJSIZEY2,NKU))
  END IF  
  !
  IF ( NRR > 0 ) THEN
    IF (       LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI    &
          .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH                     &
       ) THEN 
      NSIZELBXR_ll=2*NRIMX+2*JPHEXT
      NSIZELBYR_ll=2*NRIMY+2*JPHEXT
      ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,NKU,NRR))
      ALLOCATE(XLBYRM(IISIZEYF,IJSIZEYF,NKU,NRR))
    ELSE
      NSIZELBXR_ll=2*JPHEXT    ! 2
      NSIZELBYR_ll=2*JPHEXT    ! 2
      ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,NKU,NRR))
      ALLOCATE(XLBYRM(IISIZEY2,IJSIZEY2,NKU,NRR))
    ENDIF
  ELSE
    NSIZELBXR_ll=0
    NSIZELBYR_ll=0
    ALLOCATE(XLBXRM(0,0,0,0))
    ALLOCATE(XLBYRM(0,0,0,0))
  END IF
  !
  IF ( NSV > 0 ) THEN 
    IF ( ANY( LHORELAX_SV(:)) ) THEN
      NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
      NSIZELBYSV_ll=2*NRIMY+2*JPHEXT
      ALLOCATE(XLBXSVM(IISIZEXF,IJSIZEXF,NKU,NSV))
      ALLOCATE(XLBYSVM(IISIZEYF,IJSIZEYF,NKU,NSV))
    ELSE
      NSIZELBXSV_ll=2*JPHEXT    ! 2
      NSIZELBYSV_ll=2*JPHEXT    ! 2
      ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,NKU,NSV))
      ALLOCATE(XLBYSVM(IISIZEY2,IJSIZEY2,NKU,NSV))
    END IF
  ELSE
    NSIZELBXSV_ll=0
    NSIZELBYSV_ll=0
    ALLOCATE(XLBXSVM(0,0,0,0))
    ALLOCATE(XLBYSVM(0,0,0,0))
  END IF
END IF
!
!
!-------------------------------------------------------------------------------
!
!*       5.     INITIALIZE ALL THE MODEL VARIABLES
!   	        ----------------------------------
!
!
!*       5.1    Grid variables and RS localization:
!
!*       5.1.1  Horizontal Spatial grid :
!
IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN 
!--------------------------------------------------------
! the MESONH horizontal grid will be read in the PGD_FILE 
!--------------------------------------------------------
  CALL READ_HGRID(1,CPGD_FILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
! control the cartesian option
  IF( LCARTESIAN ) THEN
     WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : IN GENERAL, THE USE OF A PGD_FILE &
                & IMPLIES THAT YOU MUST TAKE INTO ACCOUNT THE EARTH SPHERICITY'
     WRITE(NLUOUT,FMT=*) 'NEVERTHELESS, LCARTESIAN HAS BEEN KEPT TO TRUE'
  END IF   
!
!* use of the externalized surface
!
  CSURF = "EXTE"
!
! determine whether the model is flat or no
!
  ZZS_MAX = ABS( MAXVAL(XZS(NIB:NIU-JPHEXT,NJB:NJU-JPHEXT)))
  CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MPI_PRECISION, MPI_MAX,  &
                     NMNH_COMM_WORLD,IINFO_ll)
  IF( ABS(ZZS_MAX_ll)  < 1.E-10 ) THEN
    LFLAT=.TRUE.
  ELSE
    LFLAT=.FALSE.
  END IF
!

ELSE
!------------------------------------------------------------------------
! the MESONH horizontal grid is built from the PRE_IDEA1.nam informations
!------------------------------------------------------------------------
!
  ALLOCATE(XXHAT(NIU),XYHAT(NJU))
!
! define the grid localization at the earth surface by the central point
! coordinates
!
  IF (XLONCEN/=XUNDEF .OR. XLATCEN/=XUNDEF) THEN
    IF (XLONCEN/=XUNDEF .AND. XLATCEN/=XUNDEF) THEN 
!
! it should be noted that XLATCEN and XLONCEN refer to a vertical
! vorticity point and (XLATORI, XLONORI) refer to the mass point of
! conformal coordinates (0,0). This is to allow the centering of the model in
! a non-cyclic  configuration regarding to XLATCEN or XLONCEN.
!
      ALLOCATE(ZXHAT_ll(NIMAX_ll+2*JPHEXT),ZYHAT_ll(NJMAX_ll+2*JPHEXT))
      ZXHAT_ll=0.
      ZYHAT_ll=0.
      CALL SM_LATLON(XLATCEN,XLONCEN,                     &
                       -XDELTAX*(NIMAX_ll/2-0.5+JPHEXT),  &
                       -XDELTAY*(NJMAX_ll/2-0.5+JPHEXT),  &
                       XLATORI,XLONORI)
        DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
!
      WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : XLATORI=' , XLATORI, &
                          ' XLONORI= ', XLONORI
    ELSE
      WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : LATITUDE AND LONGITUDE OF THE CENTER &
                           & POINT MUST BE INITIALIZED ALL TOGETHER OR NOT'
      WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
   !callabortstop
      CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
      CALL ABORT
      STOP
    END IF
  END IF
!
  IF (NPROC > 1) THEN
    CALL GET_DIM_EXT_ll('B',IXDIM,IYDIM)
    IBEG = IXOR-JPHEXT-1
    IEND = IBEG+IXDIM-1
    XXHAT(:) = (/ (FLOAT(JLOOP)*XDELTAX, JLOOP=IBEG,IEND) /)
    IBEG = IYOR-JPHEXT-1
    IEND = IBEG+IYDIM-1
    XYHAT(:) = (/ (FLOAT(JLOOP)*XDELTAY, JLOOP=IBEG,IEND) /)
!
  ELSE
    XXHAT(:) = (/ (FLOAT(JLOOP-NIB)*XDELTAX, JLOOP=1,NIU) /)
    XYHAT(:) = (/ (FLOAT(JLOOP-NJB)*XDELTAY, JLOOP=1,NJU) /)
  END IF
END IF
!
!*       5.1.2  Orography and Gal-Chen Sommerville transformation :
!
IF (    LEN_TRIM(CPGD_FILE) == 0  .OR. .NOT. LREAD_ZS) THEN
  SELECT CASE(CZS)     ! 'FLAT' or 'SINE' or 'BELL'
  CASE('FLAT')
    LFLAT = .TRUE.
    IF (XHMAX==XUNDEF) THEN
      XZS(:,:) = 0.
    ELSE
      XZS(:,:) = XHMAX
    END IF
  CASE('SINE')       ! sinus-shaped orography 
    IF (XHMAX==XUNDEF) XHMAX=300.
    LFLAT    =.FALSE.
    XZS(:,:) = XHMAX          &      ! three-dimensional case   
    *SPREAD((/((SIN((XPI/(NIMAX_ll+2*JPHEXT-1))*JLOOP)**2)**NEXPX,JLOOP=IXOR-1,IXOR+NIU-2)/),2,NJU) &
    *SPREAD((/((SIN((XPI/(NJMAX_ll+2*JPHEXT-1))*JLOOP)**2)**NEXPY,JLOOP=IYOR-1,IYOR+NJU-2)/),1,NIU)
    IF(L1D) THEN                     ! one-dimensional case
      XZS(:,:) = XHMAX 
    END IF        
  CASE('BELL')       ! bell-shaped orography 
    IF (XHMAX==XUNDEF) XHMAX=300.
    LFLAT = .FALSE.
    IF(.NOT.L2D) THEN                ! three-dimensional case
      XZS(:,:) = XHMAX  / ( 1.                                           &
        + ( (SPREAD(XXHAT(1:NIU),2,NJU) - FLOAT(NIZS) * XDELTAX) /XAX ) **2  &
        + ( (SPREAD(XYHAT(1:NJU),1,NIU) - FLOAT(NJZS) * XDELTAY) /XAY ) **2  ) **1.5
    ELSE                             ! two-dimensional case
      XZS(:,:) = XHMAX  / ( 1.                                          &
        + ( (SPREAD(XXHAT(1:NIU),2,NJU) - FLOAT(NIZS) * XDELTAX) /XAX ) **2 )
    ENDIF
    IF(L1D) THEN                     ! one-dimensional case
      XZS(:,:) = XHMAX 
    END IF        
  CASE('COSI')       ! (1+cosine)**4 shape
    IF (XHMAX==XUNDEF) XHMAX=800.
    LFLAT = .FALSE.
    IF(L2D) THEN                     ! two-dimensional case
      DO JILOOP = 1, NIU
        ZDIST = XXHAT(JILOOP)-FLOAT(NIZS)*XDELTAX
        IF( ABS(ZDIST)<(4.0*XAX) ) THEN
          XZS(JILOOP,:) = (XHMAX/16.0)*( 1.0 + COS((XPI*ZDIST)/(4.0*XAX)) )**4
        ELSE
          XZS(JILOOP,:) = 0.0
        ENDIF
      END DO
    ENDIF
  CASE('SCHA')       ! exp(-(x/a)**2)*cosine(pi*x/lambda)**2 shape
    IF (XHMAX==XUNDEF) XHMAX=800.
    LFLAT = .FALSE.
    IF(L2D) THEN                     ! two-dimensional case
      DO JILOOP = 1, NIU
        ZDIST = XXHAT(JILOOP)-FLOAT(NIZS)*XDELTAX
        IF( ABS(ZDIST)<(4.0*XAX) ) THEN
          XZS(JILOOP,:) = XHMAX*EXP(-(ZDIST/XAY)**2)*COS((XPI*ZDIST)/XAX)**2
        ELSE
          XZS(JILOOP,:) = 0.0
        ENDIF
      END DO
    ENDIF
  CASE('AGNE')       ! h*a**2/(x**2+a**2) shape
    LFLAT = .FALSE.
    IF(L2D) THEN                     ! two-dimensional case
      DO JILOOP = 1, NIU
        ZDIST = XXHAT(JILOOP)-FLOAT(NIZS)*XDELTAX
          XZS(JILOOP,:) = XHMAX*(XAX**2)/(XAX**2+ZDIST**2)
      END DO
		ELSE		! three dimensionnal case - infinite profile in y direction
			DO JILOOP = 1, NIU
        ZDIST = XXHAT(JILOOP)-FLOAT(NIZS)*XDELTAX
          XZS(JILOOP,:) = XHMAX*(XAX**2)/(XAX**2+ZDIST**2)
      END DO
    ENDIF

  CASE('DATA')       ! discretized orography
    LFLAT    =.FALSE.
    WRITE(NLUOUT,FMT=*) 'CZS="DATA",   ATTEMPT TO READ ARRAY     &
                    &XZS(NIB:NIU-JPHEXT:1,NJU-JPHEXT:NJB:-1) &
                    &starting from the first index'
    CALL POSKEY(NLUPRE,NLUOUT,'ZSDATA')
    DO JJLOOP = NJMAX_ll+2*JPHEXT-1,JPHEXT+1,-1    ! input like a map prior the sounding
      READ(NLUPRE,FMT=*) ZZS_ll
      IF ( ( JJLOOP <= ( NJU-JPHEXT + IYOR-1 ) ) .AND. ( JJLOOP >= ( NJB + IYOR-1 ) ) ) THEN
         IJ    = JJLOOP - ( IYOR-1 )
         XZS(NIB:NIU-JPHEXT,IJ) = ZZS_ll(IXOR:IXOR + NIU-JPHEXT - NIB )
      END IF
    END DO
!
  CASE DEFAULT   ! undefined  shape of orography
    WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: ERRONEOUS TERRAIN TYPE'
    WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
   !callabortstop
    CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
    CALL ABORT
    STOP
  END SELECT
!
  CALL ADD2DFIELD_ll(TZ_FIELDS_ll, XZS)
  CALL UPDATE_HALO_ll(TZ_FIELDS_ll,IINFO_ll)
  CALL CLEANLIST_ll(TZ_FIELDS_ll)
!
END IF
!
!IF( ( LEN_TRIM(CPGD_FILE) /= 0 ) .AND. .NOT.LFLAT .AND. &
! ((CLBCX(1) /= "OPEN" ) .OR. &
! (CLBCX(2) /= "OPEN" ) .OR. (CLBCY(1) /= "OPEN" ) .OR. &
! (CLBCY(2) /= "OPEN" )) )  THEN 
!  WRITE(NLUOUT,FMT=*) 'STOP:WITH A PGD FILE YOU CANNOT BE IN CYCLIC LBC'
!   !callabortstop
!  CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
!  CALL ABORT
!  STOP
!END IF
!
IF (LWEST_ll())  THEN
  DO JILOOP = 1,JPHEXT
    XZS(JILOOP,:) = XZS(NIB,:)
  END DO
END IF
IF (LEAST_ll()) THEN
  DO JILOOP = NIU-JPHEXT+1,NIU
    XZS(JILOOP,:)=XZS(NIU-JPHEXT,:)
  END DO
END IF
IF (LSOUTH_ll()) THEN
  DO JJLOOP = 1,JPHEXT
    XZS(:,JJLOOP)=XZS(:,NJB)
  END DO
END IF
IF (LNORTH_ll()) THEN
  DO JJLOOP =NJU-JPHEXT+1,NJU
    XZS(:,JJLOOP)=XZS(:,NJU-JPHEXT)
  END DO
END IF
!
IF ( LEN_TRIM(CPGD_FILE) == 0  .OR. .NOT. LREAD_ZS) THEN
  IF (LSLEVE) THEN
    CALL ZSMT_PIC(NSLEVE,XSMOOTH_ZS)
  ELSE
    XZSMT(:,:) = 0.
  END IF
END IF
!
IF (LCARTESIAN) THEN
  CALL SM_GRIDCART(CLUOUT,XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,XJ)
  XMAP=1.
ELSE
  CALL SM_GRIDPROJ(CLUOUT,XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, &
                   XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,XJ)
END IF
!*       5.4.1  metrics coefficients and update halos:
!
CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
!
CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)                         
!
!*       5.1.3  Compute the localization in index space of the vertical profile
!               in CSTN and RSOU cases  :
!
IF (CTYPELOC =='LATLON' ) THEN  
  IF (.NOT.LCARTESIAN) THEN                            ! compute (x,y) if 
    CALL SM_XYHAT(XLATORI,XLONORI,                 &   ! the localization 
                  XLATLOC,XLONLOC,XXHATLOC,XYHATLOC)   ! is given in latitude 
  ELSE                                                 ! and longitude
    WRITE(NLUOUT,FMT=*) 'CTYPELOC CANNOT BE LATLON IN CARTESIAN GEOMETRY'
    WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
   !callabortstop
    CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
    CALL ABORT
    STOP
  END IF 
END IF  
!
ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(NJMAX_ll+2 * JPHEXT))
CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,NRESP) !//
CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,NRESP) !//
IF (CTYPELOC /= 'IJGRID') THEN                                               
  NILOC = MINLOC(ABS(XXHATLOC-ZXHAT_ll(:)))
  NJLOC = MINLOC(ABS(XYHATLOC-ZYHAT_ll(:)))
END IF
!
IF ( L1D .AND. ( NILOC(1) /= 1 .OR. NJLOC(1) /= 1 ) ) THEN
  NILOC = 1
  NJLOC = 1
  WRITE(NLUOUT,FMT=*) 'FOR 1D CONFIGURATION, THE RS INFORMATIONS ARE TAKEN AT &
                      & I=1 AND J=1 (CENTRAL VERTICAL WITHOUT HALO)'
END IF
!
IF ( L2D .AND. ( NJLOC(1) /= 1 ) ) THEN
  NJLOC = 1
  WRITE(NLUOUT,FMT=*) 'FOR 2D CONFIGURATION, THE RS INFORMATIONS ARE TAKEN AT &
                      & J=1 (CENTRAL PLANE WITHOUT HALO)'
END IF
!
!*       5.2    Prognostic variables (not multiplied by  rhoJ) : u,v,w,theta,r
!               and 1D anelastic reference state
!
IF(LPV_PERT .AND. .NOT.(LGEOSBAL)) THEN
  WRITE(NLUOUT,FMT=*) 'FOR PV INVERSION, LGEOSBAL HAS TO BE TRUE'
   !callabortstop
  CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
  CALL ABORT
  STOP
ENDIF
!
IF(LPV_PERT .AND. NPROC>1) THEN
    WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : THE USE OF A PV INVERSION HAS TO BE &
                        & PERFORMED WITH MONOPROCESSOR MODE'
    WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
   !callabortstop
   CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
   CALL ABORT
    STOP
ENDIF
!
!*       5.2.1  Use a Radiosounding : CIDEAL='RSOU''
!
IF (CIDEAL == 'RSOU') THEN
  WRITE(NLUOUT,FMT=*) 'CIDEAL="RSOU", attempt to read DATE'
  CALL POSKEY(NLUPRE,NLUOUT,'RSOU')
  READ(NLUPRE,FMT=*)  NYEAR,NMONTH,NDAY,XTIME
  TDTCUR = DATE_TIME(DATE(NYEAR,NMONTH,NDAY),XTIME)
  TDTEXP = TDTCUR
  TDTSEG = TDTCUR
  TDTMOD = TDTCUR
  READ(NLUPRE,*) YKIND
  BACKSPACE(NLUPRE)    ! because YKIND read again in set_rsou
  WRITE(NLUOUT,FMT=*) 'CIDEAL="RSOU", ATTEMPT TO PROCESS THE SOUNDING DATA'
  IF (LGEOSBAL) THEN
    CALL SET_RSOU(CEXPRE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS,LPV_PERT,&
                  LRMV_BL,XJ,LSHIFT,XCORIOZ)
  ELSE
    CALL SET_RSOU(CEXPRE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS,LPV_PERT,&
                  LRMV_BL,XJ,LSHIFT)
  END IF
!
!*       5.2.2  N=cste  and U(z) : CIDEAL='CSTN'
!
ELSE IF (CIDEAL == 'CSTN') THEN
  WRITE(NLUOUT,FMT=*) 'CIDEAL="CSTN", attempt to read DATE'
  CALL POSKEY(NLUPRE,NLUOUT,'CSTN')
  READ(NLUPRE,FMT=*)  NYEAR,NMONTH,NDAY,XTIME
  TDTCUR = DATE_TIME(DATE(NYEAR,NMONTH,NDAY),XTIME)
  TDTEXP = TDTCUR
  TDTSEG = TDTCUR
  TDTMOD = TDTCUR
  WRITE(NLUOUT,FMT=*) 'CIDEAL="CSTN", ATTEMPT TO PROCESS THE SOUNDING DATA'
  IF (LGEOSBAL) THEN
    CALL SET_CSTN(CEXPRE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS,LPV_PERT,&
                  LRMV_BL,XJ,LSHIFT,XCORIOZ)
  ELSE
    CALL SET_CSTN(CEXPRE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS,LPV_PERT,&
                  LRMV_BL,XJ,LSHIFT)
  END IF
!
END IF 
!
!*       5.3    Forcing variables
!
IF (LFORCING) THEN
  WRITE(NLUOUT,FMT=*) 'FORCING IS ENABLED, ATTEMPT TO SET FORCING FIELDS'
  CALL POSKEY(NLUPRE,NLUOUT,'ZFRC ','PFRC')
  CALL SET_FRC(CEXPRE)
END IF
!
!! ---------------------------------------------------------------------
! Modif PP ADV FRC
! 5.4.2 initialize profiles for adv forcings
IF (L2D_ADV_FRC) THEN
    WRITE(NLUOUT,FMT=*) 'L2D_ADV_FRC IS SET TO  TRUE'
    WRITE(NLUOUT,FMT=*) 'ADVECTING FORCING USED IS USER MADE, NOT STANDARD ONE ' 
    WRITE(NLUOUT,FMT=*) 'IT IS FOR 2D IDEALIZED WAM STUDY ONLY ' 
   CALL POSKEY(NLUPRE,NLUOUT,'ZFRC_ADV')
   CALL SET_ADVFRC(CEXPRE)
ENDIF
IF (L2D_REL_FRC) THEN
    WRITE(NLUOUT,FMT=*) 'L2D_REL_FRC IS SET TO  TRUE'
    WRITE(NLUOUT,FMT=*) 'RELAXATION FORCING USED IS USER MADE, NOT STANDARD ONE ' 
    WRITE(NLUOUT,FMT=*) 'IT IS FOR 2D IDEALIZED WAM STUDY ONLY ' 
   CALL POSKEY(NLUPRE,NLUOUT,'ZFRC_REL')
   CALL SET_RELFRC(CEXPRE)
ENDIF
!*       5.4    3D Reference state variables :
!
!
!*       5.4.1  metrics coefficients and update halos:
!
CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
!
CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
!
!*       5.4.2  3D reference state :
!
CALL SET_REF(0,'NIL',CLUOUT,                                     &
             XZZ,XZHAT,XJ,XDXX,XDYY,CLBCX,CLBCY,                 &
             XREFMASS,XMASS_O_PHI0,XLINMASS,                     &
             XRHODREF,XTHVREF,XRVREF,XEXNREF,XRHODJ              )
!
!
!*       5.5.1  Absolute pressure :
!
!
!*       5.5.2  Total mass of dry air Md computation :
!
CALL TOTAL_DMASS(CLUOUT,XJ,XRHODREF,XDRYMASST)
!
!
!*       5.6    Complete prognostic variables (multipliy by  rhoJ) at time t :
!
! U grid   : gridpoint 2
IF (LWEST_ll())  XUT(1,:,:)    = 2.*XUT(2,:,:) - XUT(3,:,:)
! V grid   : gridpoint 3
IF (LSOUTH_ll())  XVT(:,1,:)    = 2.*XVT(:,2,:) - XVT(:,3,:)
! SV : gridpoint 1
XSVT(:,:,:,:) = 0.
!
!
!*       5.7   Larger scale fields initialization :
!
XLSUM(:,:,:) = XUT(:,:,:)        ! these fields do not satisfy the 
XLSVM(:,:,:) = XVT(:,:,:)        ! lower boundary condition but are 
XLSWM(:,:,:) = XWT(:,:,:)        ! in equilibrium
XLSTHM(:,:,:)= XTHT(:,:,:)
XLSRVM(:,:,:)= XRT(:,:,:,1)
!
! enforce the vertical homogeneity under the ground and above the top of
! the model for the LS fields
!
XLSUM(:,:,NKB-1)=XLSUM(:,:,NKB)
XLSUM(:,:,NKU)=XLSUM(:,:,NKU-1)
XLSVM(:,:,NKB-1)=XLSVM(:,:,NKB)
XLSVM(:,:,NKU)=XLSVM(:,:,NKU-1)
XLSWM(:,:,NKB-1)=XLSWM(:,:,NKB)
XLSWM(:,:,NKU)=XLSWM(:,:,NKU-1)
XLSTHM(:,:,NKB-1)=XLSTHM(:,:,NKB)
XLSTHM(:,:,NKU)=XLSTHM(:,:,NKU-1)
IF ( NRR > 0 ) THEN
  XLSRVM(:,:,NKB-1)=XLSRVM(:,:,NKB)
  XLSRVM(:,:,NKU)=XLSRVM(:,:,NKU-1)
END IF
!
ILBX=SIZE(XLBXUM,1)
ILBY=SIZE(XLBYUM,2)
IF(LWEST_ll() .AND. .NOT. L1D) THEN
  XLBXUM(1:NRIMX+JPHEXT,        :,:)     = XUT(2:NRIMX+JPHEXT+1,        :,:)
  XLBXVM(1:NRIMX+JPHEXT,        :,:)     = XVT(1:NRIMX+JPHEXT,        :,:)
  XLBXWM(1:NRIMX+JPHEXT,        :,:)     = XWT(1:NRIMX+JPHEXT,        :,:)
  XLBXTHM(1:NRIMX+JPHEXT,        :,:)   = XTHT(1:NRIMX+JPHEXT,        :,:)
  XLBXRM(1:NRIMX+JPHEXT,        :,:,:)   = XRT(1:NRIMX+JPHEXT,        :,:,:)
ENDIF
IF(LEAST_ll() .AND. .NOT. L1D) THEN
  XLBXUM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:)     = XUT(NIU-NRIMX-JPHEXT+1:NIU,    :,:)
  XLBXVM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:)     = XVT(NIU-NRIMX-JPHEXT+1:NIU,    :,:)
  XLBXWM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:)     = XWT(NIU-NRIMX-JPHEXT+1:NIU,    :,:)
  XLBXTHM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:)   = XTHT(NIU-NRIMX-JPHEXT+1:NIU,    :,:)
  XLBXRM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:,:)   = XRT(NIU-NRIMX-JPHEXT+1:NIU,    :,:,:)
ENDIF
IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) THEN
  XLBYUM(:,1:NRIMY+JPHEXT,        :)     = XUT(:,1:NRIMY+JPHEXT,      :)
  XLBYVM(:,1:NRIMY+JPHEXT,        :)     = XVT(:,2:NRIMY+JPHEXT+1,      :)
  XLBYWM(:,1:NRIMY+JPHEXT,        :)     = XWT(:,1:NRIMY+JPHEXT,  :)
  XLBYTHM(:,1:NRIMY+JPHEXT,        :)    = XTHT(:,1:NRIMY+JPHEXT,      :)
  XLBYRM(:,1:NRIMY+JPHEXT,        :,:)   = XRT(:,1:NRIMY+JPHEXT,      :,:)
ENDIF
IF(LNORTH_ll().AND. .NOT. L1D .AND. .NOT. L2D) THEN
  XLBYUM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:)     = XUT(:,NJU-NRIMY-JPHEXT+1:NJU,  :)
  XLBYVM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:)     = XVT(:,NJU-NRIMY-JPHEXT+1:NJU,  :)
  XLBYWM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:)     = XWT(:,NJU-NRIMY-JPHEXT+1:NJU,  :)
  XLBYTHM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:)    = XTHT(:,NJU-NRIMY-JPHEXT+1:NJU,  :)
  XLBYRM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:,:)   = XRT(:,NJU-NRIMY-JPHEXT+1:NJU,  :,:)
ENDIF
DO JSV = 1, NSV
  IF(LWEST_ll() .AND. .NOT. L1D) &
  XLBXSVM(1:NRIMX+JPHEXT,        :,:,JSV)   = XSVT(1:NRIMX+JPHEXT,        :,:,JSV)
  IF(LEAST_ll() .AND. .NOT. L1D) &
  XLBXSVM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:,JSV)   = XSVT(NIU-NRIMX-JPHEXT+1:NIU,    :,:,JSV)
  IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
  XLBYSVM(:,1:NRIMY+JPHEXT,        :,JSV)   = XSVT(:,1:NRIMY+JPHEXT,      :,JSV)
  IF(LNORTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
  XLBYSVM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:,JSV)   = XSVT(:,NJU-NRIMY-JPHEXT+1:NJU,  :,JSV)
END DO
!
!
!*       5.8   Add a perturbation to a basic state :
!
IF(LPERTURB) CALL SET_PERTURB(CEXPRE)
!
!
!*       5.9   Anelastic correction and pressure:
!
CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
IF ( .NOT. L1D ) CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
!
!
!*       5.10  Compute THETA, vapor and cloud mixing ratio
!
IF (CIDEAL == 'RSOU') THEN
    ALLOCATE(ZEXN(NIU,NJU,NKU))         
  ALLOCATE(ZT(NIU,NJU,NKU))  
  ALLOCATE(ZTHL(NIU,NJU,NKU))              
  ALLOCATE(ZRT(NIU,NJU,NKU))              
  ALLOCATE(ZCPH(NIU,NJU,NKU))        
  ALLOCATE(ZLVOCPEXN(NIU,NJU,NKU))        
  ALLOCATE(ZLSOCPEXN(NIU,NJU,NKU))  
  ALLOCATE(ZFRAC_ICE(NIU,NJU,NKU))
  ALLOCATE(ZRSATW(NIU,NJU,NKU))
  ALLOCATE(ZRSATI(NIU,NJU,NKU))             
  ZRT=XRT(:,:,:,1)+XRT(:,:,:,2)+XRT(:,:,:,4)
  ZEXN=(XPABST/XP00) ** (XRD/XCPD)
  ZT=XTHT*(XPABST/XP00)**(XRD/XCPD)
  ZCPH=XCPD+ XCPV * XRT(:,:,:,1)+ XCL *XRT(:,:,:,2)  + XCI * XRT(:,:,:,4)
  ZLVOCPEXN = (XLVTT + (XCPV-XCL) * (ZT-XTT))/(ZCPH*ZEXN)
  ZLSOCPEXN = (XLSTT + (XCPV-XCI) * (ZT-XTT))/(ZCPH*ZEXN)
  ZTHL=XTHT-ZLVOCPEXN*XRT(:,:,:,2)-ZLSOCPEXN*XRT(:,:,:,4)
  DEALLOCATE(ZEXN)         
  DEALLOCATE(ZT)       
  DEALLOCATE(ZCPH)        
  DEALLOCATE(ZLVOCPEXN)        
  DEALLOCATE(ZLSOCPEXN)
  CALL TH_R_FROM_THL_RT_3D('T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
                            XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI)
  DEALLOCATE(ZTHL) 
  DEALLOCATE(ZRT)
! Coherence test
  IF ((.NOT. LUSERI) ) THEN
    IF (MAXVAL(XRT(:,:,:,4))/= 0) THEN
       WRITE(NLUOUT,FMT=*) "*********************************"             
       WRITE(NLUOUT,FMT=*) 'WARNING'      
       WRITE(NLUOUT,FMT=*) 'YOU HAVE LUSERI=FALSE '
       WRITE(NLUOUT,FMT=*) ' BUT WITH YOUR RADIOSOUNDING Ri/=0'
       WRITE(NLUOUT,FMT=*) MINVAL(XRT(:,:,:,4)),MAXVAL(XRT(:,:,:,4))
       WRITE(NLUOUT,FMT=*) "*********************************"       
    ENDIF  
  ENDIF
  IF ((.NOT. LUSERC)) THEN
    IF (MAXVAL(XRT(:,:,:,2))/= 0) THEN          
      WRITE(NLUOUT,FMT=*) "*********************************"
      WRITE(NLUOUT,FMT=*) 'WARNING'    
      WRITE(NLUOUT,FMT=*) 'YOU HAVE LUSERC=FALSE '
      WRITE(NLUOUT,FMT=*) 'BUT WITH YOUR RADIOSOUNDING RC/=0'
      WRITE(NLUOUT,FMT=*) MINVAL(XRT(:,:,:,2)),MAXVAL(XRT(:,:,:,2))      
      WRITE(NLUOUT,FMT=*) "*********************************"
    ENDIF  
  ENDIF
      ! on remet les bonnes valeurs pour NRR
  IF(CCLOUD=='NONE') NRR=1
  IF(CCLOUD=='REVE') NRR=2
END IF
!
!-------------------------------------------------------------------------------
!
!*  	 6.    INITIALIZE SCALAR VARIABLES FOR CHEMISTRY
!   	       -----------------------------------------
!
!  before calling chemistry
CCONF = 'START'
CSTORAGE_TYPE='TT'                  
CALL CLOSE_ll(CEXPRE,IOSTAT=NRESP)  ! Close the EXPRE file 
!
IF ( LCH_INIT_FIELD ) CALL CH_INIT_FIELD_n(1, NLUOUT, NVERB)
!
!-------------------------------------------------------------------------------
!
!*   	 7.    WRITE THE FMFILE 
!   	       ----------------
!
CALL SECOND_MNH2(ZTIME1)
!
NNPRAR = 22 + 2*(NRR+NSV)   &    ! 22 = number of grid variables + reference 
       + 8 + 17                  ! state variables + dimension variables
                                 ! 2*(8+NRR+NSV) + 1 = number of prognostic
                                 ! variables at time t and t-dt
NTYPE=1
CDESFM=ADJUSTL(ADJUSTR(CINIFILE)//'.des')
!
TZFILE%CNAME      = CINIFILE
TZFILE%CTYPE      = 'PREPIDEALCASE'
IF (LCDF4) THEN
  IF (.NOT.LLFIOUT) THEN
    TZFILE%CFORMAT='NETCDF4'
  ELSE
    TZFILE%CFORMAT='LFICDF4'
    TZFILE%NLFINPRAR= NNPRAR
  END IF
ELSE IF (LLFIOUT) THEN
  TZFILE%CFORMAT='LFI'
  TZFILE%NLFINPRAR= NNPRAR
ELSE
  PRINT *,'Error: unknown backup/output fileformat'
  CALL ABORT
ENDIF
TZFILE%CMODE      = 'WRITE'
TZFILE%NLFITYPE   = NTYPE
TZFILE%NLFIVERB   = NVERB
!
CALL INI_FIELD_LIST()
!
CALL IO_FILE_OPEN_ll(TZFILE,CLUOUT,NRESP)
!
CALL WRITE_DESFM_n(1,CDESFM,CLUOUT)
!
CALL WRITE_LFIFM_n(TZFILE,'                            ')  ! There is no DAD model for PREP_IDEAL_CASE 
!
CALL SECOND_MNH2(ZTIME2)
!
XT_STORE = XT_STORE + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
!*     8.     EXTERNALIZED SURFACE
!             --------------------
!
!
IF (CSURF =='EXTE') THEN
  IF (LEN_TRIM(CINIFILEPGD)==0) THEN
    IF (LEN_TRIM(CPGD_FILE)/=0) THEN
      CINIFILEPGD=CPGD_FILE
    ELSE
      WRITE(NLUOUT,FMT=*) 'STOP : CINIFILEPGD needed in NAM_LUNITn'
      !callabortstop
      CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
      CALL ABORT
      STOP
    ENDIF      
  ENDIF
  CALL SURFEX_ALLOC_LIST(1)
  YSURF_CUR => YSURF_LIST(1)
  CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)              
  ! Switch to model 1 surface variables
  CALL GOTO_SURFEX(1)
  !* definition of physiographic fields
  ! computed ...
  IF (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM) THEN
    CPGDFILE = CINIFILE
    CALL PGD_GRID_SURF_ATM(YSURF_CUR%UG, YSURF_CUR%U,YSURF_CUR%GCP,'MESONH',CINIFILE,'MESONH',.TRUE.)
    CALL PGD_SURF_ATM     (YSURF_CUR,'MESONH',CINIFILE,'MESONH',.TRUE.)
    CPGDFILE = CINIFILEPGD                                   
  ELSE
  ! ... or read from file.
    CPGDFILE = CPGD_FILE
    CALL INIT_PGD_SURF_ATM(YSURF_CUR,'MESONH','PGD',                         &
                            '                            ','      ',&
                            TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH,  &
                            TDTCUR%TDATE%DAY, TDTCUR%TIME           )
!
  END IF
  !
  !* forces orography from atmospheric file
  IF (.NOT. LREAD_ZS) CALL MNHPUT_ZS_n
  !
  ! on ecrit un nouveau fichier PGD que s'il n'existe pas
  IF (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM) THEN
    !* writing of physiographic fields in the file
    CSTORAGE_TYPE='PG'
    COUTFMFILE = CINIFILEPGD
    CALL FMOPEN_ll(CINIFILEPGD,'WRITE',CLUOUT,NNPRAR,NTYPE,NVERB,NNINAR,NRESP)  
    CALL FMWRIT(CINIFILEPGD,'PROGRAM     ',CLUOUT,'--',CPROGRAM,0,1,' ',NRESP)
    CALL FMWRIT(CINIFILEPGD,'SURF        ',CLUOUT,'--','EXTE',0,1,' ',NRESP)
    CALL FMWRIT(CINIFILEPGD,'L1D         ',CLUOUT,'--',L1D,0,1,' ',NRESP)
    CALL FMWRIT(CINIFILEPGD,'L2D         ',CLUOUT,'--',L2D,0,1,' ',NRESP)
    CALL FMWRIT(CINIFILEPGD,'PACK        ',CLUOUT,'--',LPACK,0,1,' ',NRESP)
    CALL WRITE_HGRID(1,CINIFILEPGD,' ')
    CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
  CSTORAGE_TYPE='TT'
  ENDIF
  
  !
  !
  !* rereading of physiographic fields and definition of prognostic fields
  !* writing of all surface fields
  COUTFMFILE = CINIFILE
  CALL PREP_SURF_MNH('                            ','      ')
  CALL SURFEX_DEALLO_LIST
ELSE
  CSURF = "NONE"
END IF
!
!-------------------------------------------------------------------------------
!
!*     9.     CLOSES THE FILE
!             ---------------
!
IF (CSURF =='EXTE' .AND. (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM)) THEN
  CALL FMCLOS_ll(CINIFILEPGD,'KEEP',CLUOUT,NRESP)
ENDIF
CALL IO_FILE_CLOSE_ll(TZFILE,CLUOUT,NRESP)
IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
  CALL FMCLOS_ll(CPGD_FILE,'KEEP',CLUOUT,NRESP)
ENDIF
!
!
!-------------------------------------------------------------------------------
!
!*      10.    PRINTS ON OUTPUT-LISTING
!              ------------------------
!
IF (NVERB >= 5) THEN
  WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: LCARTESIAN,CIDEAL,CZS=', &
                                    LCARTESIAN,CIDEAL,CZS 
  WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: LUSERV=',LUSERV
  WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: XLON0,XLAT0,XBETA,XRPK,XLONORI,XLATORI=', &
                                    XLON0,XLAT0,XBETA,XRPK,XLONORI,XLATORI
  WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: XDELTAX,XDELTAY=',XDELTAX,XDELTAY
  WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: NVERB=',NVERB
  IF(LCARTESIAN) THEN
    WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: No map projection used.'
  ELSE
    IF (XRPK == 1.) THEN
      WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Polar stereo used.'
    ELSE IF (XRPK == 0.) THEN
      WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Mercator used.'
    ELSE
      WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Lambert used, cone factor=',XRPK 
    END IF
  END IF
END IF
!
IF (NVERB >= 5) THEN
  WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: IIB, IJB, IKB=',NIB,NJB,NKB
  WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: IIU, IJU, IKU=',NIU,NJU,NKU
END IF
!
!
!*       28.1   print statistics!
!
  !
  CALL SECOND_MNH2(ZTIME2)
  XT_START=XT_START+ZTIME2-ZEND
  !
  ! Set File Timing OUTPUT
  !
  CALL SET_ILUOUT_TIMING(NLUOUT)
  !
  ! Compute global time
  !
  CALL TIME_STAT_ll(XT_START,ZTOT)
  !
  !
  IMI = 1
  CALL TIME_HEADER_ll(IMI)
  !
  CALL TIME_STAT_ll(XT_STORE,ZTOT,      ' STORE-FIELDS','=')
  CALL  TIMING_SEPARATOR('+')
  CALL  TIMING_SEPARATOR('+')  
  WRITE(YMI,FMT="(I0)") IMI
  CALL TIME_STAT_ll(XT_START,ZTOT,      ' MODEL'//YMI,'+')
  CALL  TIMING_SEPARATOR('+')
  CALL  TIMING_SEPARATOR('+')
  CALL  TIMING_SEPARATOR('+')
WRITE(NLUOUT,FMT=*) ' '
WRITE(NLUOUT,FMT=*) '****************************************************'
WRITE(NLUOUT,FMT=*) '* PREP_IDEAL_CASE: PREP_IDEAL_CASE ENDS CORRECTLY. *'
WRITE(NLUOUT,FMT=*) '****************************************************'
!
CALL CLOSE_ll(CLUOUT,IOSTAT=NRESP)
CALL END_PARA_ll(IINFO_ll)
!
! 
   !callabortstop
   !JUAN CALL ABORT
STOP
!
END PROGRAM PREP_IDEAL_CASE