Newer
Older
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
!
IF (GINIRAD) CALL SUNPOS_n(XZENITH,PAZIMSOL=XAZIM)
CALL SURF_SOLAR_GEOM (XZS, XZS_XY)
!
ALLOCATE(XXHAT_ll (IIU_ll))
ALLOCATE(XYHAT_ll (IJU_ll))
ALLOCATE(XZS_ll (IIU_ll,IJU_ll))
ALLOCATE(XZS_XY_ll (IIU_ll,IJU_ll))
!
CALL GATHERALL_FIELD_ll('XY',XZS,XZS_ll,IRESP)
CALL GATHERALL_FIELD_ll('XY',XZS_XY,XZS_XY_ll,IRESP)
CALL GATHERALL_FIELD_ll('XX',XXHAT,XXHAT_ll,IRESP)
CALL GATHERALL_FIELD_ll('YY',XYHAT,XYHAT_ll,IRESP)
XZS_MAX_ll=MAXVAL(XZS_ll)
ELSE
XAZIM = XPI
XZENITH = XPI/2.
XDIRSRFSWD = 0.
XSCAFLASWD = 0.
XFLALWD = 300. ! W/m2
XTSIDER = 0.
END IF
!
!
CALL INI_SW_SETUP (CRAD,NSWB_MNH,XSW_BANDS)
CALL INI_LW_SETUP (CRAD,NLWB_MNH,XLW_BANDS)
! 17.1.1 Special initialisation for CO2 content
! CO2 (molar mass=44) horizontally and vertically homogeneous at 360 ppm
!
XCCO2 = 360.0E-06 * 44.0E-03 / XMD
#ifdef MNH_ECRAD
RCCO2 = 360.0E-06 * 44.0E-03 / XMD
#endif
! ---------------------------
!
ALLOCATE(ZCO2(IIU,IJU))
ZCO2(:,:) = XCCO2
!
ALLOCATE(ZDIR_ALB(IIU,IJU,NSWB_MNH))
ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH))
ALLOCATE(ZEMIS (IIU,IJU,NLWB_MNH))
WAUTELET Philippe
committed
IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
CALL IO_READ_FIELD(TPINIFILE,'SURF',CSURF)
ELSE
CSURF = "EXTE"
END IF
!
!
IF (CSURF=='EXTE' .AND. (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ')) THEN
! ouverture du fichier PGD
IF ( LEN_TRIM(CINIFILEPGD) > 0 ) THEN
WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(TINIFILEPGD,TRIM(CINIFILEPGD),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
WAUTELET Philippe
committed
CALL IO_FILE_OPEN_ll(TINIFILEPGD,OPARALLELIO=.FALSE.,KRESP=IRESP)
WAUTELET Philippe
committed
LUNIT_MODEL(KMI)%TINIFILEPGD => TINIFILEPGD
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 PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
ENDIF
ELSE
! case after a spawning
Juan Escobar
committed
#ifdef CPLOASIS
CALL SFX_OASIS_READ_NAM(CPROGRAM,XTSTEP)
WRITE(*,*) 'SFX-OASIS: READ NAM_SFX_SEA_CPL OK'
#endif
!* initialization of surface
CALL INIT_GROUND_PARAM_n ('ALL',SIZE(CSV),CSV,ZCO2, &
XZENITH,XAZIM,XSW_BANDS,XLW_BANDS,ZDIR_ALB,ZSCA_ALB, &
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
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
WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(TINIFILEPGD,TRIM(CINIFILEPGD),'UNKNOWN','READ',KLFITYPE=2,KLFIVERB=NVERB)
WAUTELET Philippe
committed
CALL IO_FILE_OPEN_ll(TINIFILEPGD,OPARALLELIO=.FALSE.,KRESP=IRESP)
WAUTELET Philippe
committed
LUNIT_MODEL(KMI)%TINIFILEPGD => TINIFILEPGD
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 PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
!
IF (.NOT.ASSOCIATED(TINIFILEPGD)) TINIFILEPGD => TFILE_DUMMY
!
!* 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' .OR. CRAD == 'ECRA') .AND. CGETRAD=='READ') THEN
WAUTELET Philippe
committed
CALL INI_SURF_RAD(TPINIFILE, XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD)
WAUTELET Philippe
committed
IF (CPROGRAM/='REAL ') CALL MNHREAD_ZS_DUMMY_n(TINIFILEPGD)
!
!-------------------------------------------------------------------------------
!
!* 18. 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))
CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
ZSEA (:,:) = 1.
ZTOWN(:,:) = 0.
ZBARE(:,:) = 0.
CALL INI_RADIATIONS_ECMWF (TPINIFILE%CNAME,HLUOUT, &
XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,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(:,:,:,:)
ELSE IF (CRAD == 'ECRA') THEN
#ifdef MNH_ECRAD
!* 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)
ELSE
ZSEA (:,:) = 1.
ZTOWN(:,:) = 0.
ZBARE(:,:) = 0.
END IF
!
CALL INI_RADIATIONS_ECRAD (TPINIFILE%CNAME,HLUOUT, &
XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,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
#endif
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
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
WAUTELET Philippe
committed
CALL INI_DEEP_CONVECTION (TPINIFILE,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
!
!-------------------------------------------------------------------------------
!
!
! ---------------------------------
!
IF (LSERIES .AND. CPROGRAM/='DIAG ') CALL INI_SERIES_n
!
!-------------------------------------------------------------------------------
!
!
! -------------------------------
!
!
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
!
!-------------------------------------------------------------------------------
!
! -----------
!
!
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)
!
!
!-------------------------------------------------------------------------------
!
! -------------
!
DEALLOCATE(ZJ)
!
DEALLOCATE(XSTROATM)
DEALLOCATE(XSMLSATM)
DEALLOCATE(XSMLWATM)
DEALLOCATE(XSPOSATM)
DEALLOCATE(XSPOWATM)
!
!-------------------------------------------------------------------------------
!
! ------------------------------------
!
CALL INI_AIRCRAFT_BALLOON(TPINIFILE,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
IKU,CTURB=="TKEL" , &
XLATORI, XLONORI )
!
!-------------------------------------------------------------------------------
!
CALL INI_SURFSTATION_n(XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
CTURB=="TKEL" , &
XLATORI, XLONORI )
!
!-------------------------------------------------------------------------------
!
CALL INI_POSPROFILER_n(XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
CTURB=="TKEL", &
XLATORI, XLONORI )
!
!-------------------------------------------------------------------------------
!
! ------------------------
!
CALL INI_AEROSET1
CALL INI_AEROSET2
CALL INI_AEROSET3
CALL INI_AEROSET4
CALL INI_AEROSET5
CALL INI_AEROSET6
#ifdef MNH_FOREFIRE
!
!-------------------------------------------------------------------------------
! ------------------------
!
! 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
Gaelle DELAUTIER
committed
!-------------------------------------------------------------------------------
!
!* 30. Total production/Loss for chemical species
!
Gaelle DELAUTIER
committed
IF (LCHEMDIAG) THEN
Gaelle DELAUTIER
committed
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
!
Gaelle DELAUTIER
committed
IF (LCHEMDIAG) THEN
Gaelle DELAUTIER
committed
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