Skip to content
Snippets Groups Projects
ini_modeln.f90 81.6 KiB
Newer Older
  • Learn to ignore specific revisions
  •   CSURF = "EXTE"
    END IF
    !
    !
    IF (CSURF=='EXTE' .AND. (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG  ')) THEN
      ! ouverture du fichier PGD
      IF  ( LEN_TRIM(CINIFILEPGD) > 0 ) THEN
    
        CALL FMOPEN_ll(CINIFILEPGD,'READ',HLUOUT,0,2,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.) 
    
        IF (IRESP/=0) THEN
          WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR TO OPEN THE FILE CINIFILEPGD=",CINIFILEPGD
          WRITE(ILUOUT,FMT=*) "CHECK YOUR NAMELIST NAM_LUNITn"
        !callabortstop
          CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
          CALL ABORT
          STOP
        ENDIF
      ELSE
      ! case after a spawning
        CINIFILEPGD = HINIFILE
      END IF
      !
    
      CALL GOTO_SURFEX(KMI)
    
      !* initialization of surface
      CALL INIT_GROUND_PARAM_n ('ALL',SIZE(CSV),CSV,ZCO2,                             &
                                XZENITH,XAZIM,XSW_BANDS,ZDIR_ALB,ZSCA_ALB,  &
                                ZEMIS,ZTSRAD                                )
      !
      IF (SIZE(XEMIS)>0) THEN
        XDIR_ALB = ZDIR_ALB
        XSCA_ALB = ZSCA_ALB
        XEMIS    = ZEMIS
        XTSRAD   = ZTSRAD
        CALL MNHGET_SURF_PARAM_n (PSEA=XSEA)                          
      END IF
    ELSE
      !* fields not physically necessary, but must be initialized
      IF (SIZE(XEMIS)>0) THEN
        XDIR_ALB = 0.
        XSCA_ALB = 0.
        XEMIS    = 1.
        XTSRAD   = XTT
        XSEA     = 1.
      END IF
    END IF
    IF (CSURF=='EXTE' .AND. (CPROGRAM=='SPAWN ')) THEN
      ! ouverture du fichier PGD
    
      CALL FMOPEN_ll(CINIFILEPGD,'READ',HLUOUT,0,2,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.) 
    
      IF (IRESP/=0) THEN
        WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR TO OPEN THE FILE CINIFILEPGD=",CINIFILEPGD
        WRITE(ILUOUT,FMT=*) "CHECK YOUR NAMELIST NAM_LUNIT2_SPA"
        !callabortstop
        CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
        CALL ABORT
        STOP
      ENDIF
    ENDIF
    !
      !* special case after spawning in prep_real_case
    IF (CSURF=='EXRM' .AND. CPROGRAM=='REAL  ') CSURF = 'EXTE'
    !
    DEALLOCATE(ZDIR_ALB)
    DEALLOCATE(ZSCA_ALB)
    DEALLOCATE(ZEMIS   )
    DEALLOCATE(ZTSRAD  )
    !
    DEALLOCATE(ZCO2)
    !
    !
    !* in a RESTART case, reads surface radiative quantities in the MESONH file
    !
    IF (CRAD   == 'ECMW' .AND. CGETRAD=='READ') THEN
      CALL INI_SURF_RAD(HINIFILE, CLUOUT, XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD)
    END IF
    !
    !
    
    !*      18.3   Mesonh fields
    
    !              -------------
    !
    IF (CPROGRAM/='REAL  ') CALL MNHREAD_ZS_DUMMY_n(CINIFILEPGD)
    !
    !-------------------------------------------------------------------------------
    !
    
    !*       19.    INITIALIZE THE PARAMETERS FOR THE PHYSICS
    
    !               -----------------------------------------
    !
    IF (CRAD   == 'ECMW') THEN
    !
    !* get cover mask for aerosols
    !
      IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG  ') THEN
    
        ALLOCATE(ZSEA(IIU,IJU))
        ALLOCATE(ZTOWN(IIU,IJU))
        ALLOCATE(ZBARE(IIU,IJU))
    
        IF (CSURF=='EXTE') THEN
    
          CALL GOTO_SURFEX(KMI)
    
          CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
    
          ZSEA (:,:) = 1.
          ZTOWN(:,:) = 0.
          ZBARE(:,:) = 0.
    
        END IF
    !
        CALL INI_RADIATIONS_ECMWF (HINIFILE,HLUOUT,                                           &
                                   XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP,          &
                                   CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB,CAER,NAER,NSTATM,          &
    
                                   XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND              )
    
        DEALLOCATE(ZSEA,ZTOWN,ZBARE)
    
        ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
        XAER_CLIM(:,:,:,:) =XAER(:,:,:,:)
    
    !
      END IF
    ELSE
      ALLOCATE (XOZON(0,0,0))
      ALLOCATE (XAER(0,0,0,0))
      ALLOCATE (XDST_WL(0,0,0,0))
      ALLOCATE (XAER_CLIM(0,0,0,0))  
    END IF
    !
    !
    !
    IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
      IF (CGETCONV=='INIT') THEN
        GINIDCONV=.TRUE.
      ELSE
        GINIDCONV=.FALSE.
      END IF
    !
    !  commensurability between convection calling time and time step
    !
      XDTCONV=XTSTEP*REAL( INT( (MIN(XDTCONV,1800.)+1.E-10)/XTSTEP ) )
      XDTCONV=MAX( XDTCONV, XTSTEP )
      IF (NVERB>=10) THEN
        WRITE(ILUOUT,*) 'XDTCONV has been set to : ',XDTCONV
      END IF
      CALL INI_DEEP_CONVECTION (HINIFILE,HLUOUT,GINIDCONV,TDTCUR,        &
                               NCOUNTCONV,XDTHCONV,XDRVCONV,XDRCCONV,    &
                               XDRICONV,XPRCONV,XPRSCONV,XPACCONV,       &
                               XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV,&
                               XCAPE,NCLTOPCONV,NCLBASCONV,              &
    
                               TDTDCONV, CGETSVCONV, XDSVCONV,           &
    
                               LCH_CONV_LINOX, XIC_RATE, XCG_RATE,       &
                               XIC_TOTAL_NUMBER, XCG_TOTAL_NUMBER        )
    
    END IF
    !
    !-------------------------------------------------------------------------------
    !
    !
    
    !*      19.    ALLOCATION OF THE TEMPORAL SERIES
    
    !              ---------------------------------
    !
    IF (LSERIES .AND. CPROGRAM/='DIAG  ') CALL INI_SERIES_n
    !
    !-------------------------------------------------------------------------------
    !
    !
    
    !*      20.   (re)initialize scalar variables
    
    !             -------------------------------
    !
    !
    IF ( LUSECHEM .OR. LCHEMDIAG ) THEN
      IF (CPROGRAM=='MESONH'.AND.CCONF=='RESTA') LCH_INIT_FIELD =.FALSE.
      IF (CPROGRAM=='MESONH'.OR. CPROGRAM=='DIAG  ' .OR. CPROGRAM=='IDEAL ') &
            CALL CH_INIT_FIELD_n(KMI, ILUOUT, NVERB)
    END IF
    !
    !-------------------------------------------------------------------------------
    !
    
    !*      22.    UPDATE HALO
    
    !              -----------
    !
    !
    CALL UPDATE_HALO_ll(TZINITHALO3D_ll,IINFO_ll)
    CALL UPDATE_HALO_ll(TZINITHALO2D_ll,IINFO_ll)
    CALL CLEANLIST_ll(TZINITHALO3D_ll)
    CALL CLEANLIST_ll(TZINITHALO2D_ll)
    !
    !
    !-------------------------------------------------------------------------------
    !
    
    !*      23.    DEALLOCATION
    
    !              -------------
    !
    DEALLOCATE(ZJ)
    !
    DEALLOCATE(XSTROATM)
    DEALLOCATE(XSMLSATM)
    DEALLOCATE(XSMLWATM)
    DEALLOCATE(XSPOSATM)
    DEALLOCATE(XSPOWATM)
    !
    !-------------------------------------------------------------------------------
    !
    
    !*      24.     BALLOON and AIRCRAFT initializations
    
    !              ------------------------------------
    !
    CALL INI_AIRCRAFT_BALLOON(HINIFILE,CLUOUT,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV,  &
                              IKU,CTURB=="TKEL" ,                                 &
                              XLATORI, XLONORI                                    )
    !
    !-------------------------------------------------------------------------------
    !
    
    !*      25.     STATION initializations
    
    !              -----------------------
    !
    CALL INI_SURFSTATION_n(CLUOUT,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV,  &
                           CTURB=="TKEL" ,                            &
                           XLATORI, XLONORI                           )
    !
    !-------------------------------------------------------------------------------
    !
    
    !*      26.     PROFILER initializations
    
    !              ------------------------
    !
    CALL INI_POSPROFILER_n(CLUOUT,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV,  &
                           CTURB=="TKEL",                             &
                           XLATORI, XLONORI                           )
    !
    !-------------------------------------------------------------------------------
    !
    !*      28.     Prognostic aerosols          
    !              ------------------------
    !
    CALL INI_AEROSET1
    CALL INI_AEROSET2
    CALL INI_AEROSET3
    CALL INI_AEROSET4
    CALL INI_AEROSET5
    CALL INI_AEROSET6
    
    #ifdef MNH_FOREFIRE
    ! 
    !-------------------------------------------------------------------------------
    
    !*      29.    FOREFIRE initializations
    !              ------------------------
    !
    
    ! Coupling with ForeFire if resolution is low enough
    !---------------------------------------------------
    IF ( LFOREFIRE .AND. 0.5*(XXHAT(2)-XXHAT(1)+XYHAT(2)-XYHAT(1)) < COUPLINGRES ) THEN
    	FFCOUPLING = .TRUE.	
    ELSE
    	FFCOUPLING = .FALSE.
    ENDIF
    
    ! Initializing the ForeFire variables
    !------------------------------------
    IF ( LFOREFIRE ) THEN
    	CALL INIT_FOREFIRE_n(KMI, ILUOUT, IP &
    		, TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, TDTCUR%TDATE%DAY, TDTCUR%TIME, XTSTEP)
    END IF
    #endif
    
    !-------------------------------------------------------------------------------
    !
    !*      30.   Total production/Loss for chemical species
    !
    
            CALL CH_INIT_PRODLOSSTOT_n(ILUOUT)
            IF (NEQ_PLT>0) THEN
                    ALLOCATE(XPROD(IIU,IJU,IKU,NEQ_PLT))
                    ALLOCATE(XLOSS(IIU,IJU,IKU,NEQ_PLT))
                    XPROD=0.0
                    XLOSS=0.0
            ELSE
                    ALLOCATE(XPROD(0,0,0,0))
                    ALLOCATE(XLOSS(0,0,0,0))
            END IF
    ELSE
            ALLOCATE(XPROD(0,0,0,0))
            ALLOCATE(XLOSS(0,0,0,0))
    END IF
    !
    !-------------------------------------------------------------------------------
    !
    !*     31. Extended production/loss terms for chemical species
    !
    
            CALL CH_INIT_BUDGET_n(ILUOUT)
            IF (NEQ_BUDGET>0) THEN
                    ALLOCATE(IINDEX(2,NNONZEROTERMS))
                    ALLOCATE(IIND(NEQ_BUDGET))
                    CALL CH_NONZEROTERMS(KMI,IINDEX,NNONZEROTERMS)
                    ALLOCATE(XTCHEM(NEQ_BUDGET))
                    DO JM=1,NEQ_BUDGET
                            IIND(JM)=COUNT((IINDEX(1,:))==NSPEC_BUDGET(JM))
                            ALLOCATE(XTCHEM(JM)%NB_REAC(IIND(JM)))
                            ALLOCATE(XTCHEM(JM)%XB_REAC(IIU,IJU,IKU,IIND(JM)))
                    END DO
                    DEALLOCATE(IIND)
                    DEALLOCATE(IINDEX)
            ELSE
                    ALLOCATE(XTCHEM(0))
            END IF
    ELSE
            ALLOCATE(XTCHEM(0))
    END IF
    
    
    END SUBROUTINE INI_MODEL_n