! ! $Id: suecrad.F90 5294 2024-10-29 18:35:00Z fairhead $ ! SUBROUTINE SUECRAD (KULOUT, KLEV, PETAH ) !**** *SUECRAD* - INITIALIZE COMMONS YOERxx CONTROLLING RADIATION ! PURPOSE. ! -------- ! INITIALIZE YOERAD, THE COMMON THAT CONTROLS THE ! RADIATION OF THE MODEL, AND YOERDU THAT INCLUDES ! ADJUSTABLE PARAMETERS FOR RADIATION COMPUTATIONS !** INTERFACE. ! ---------- ! CALL *SUECRAD* FROM *SUPHEC* ! ------- ------ ! EXPLICIT ARGUMENTS : ! -------------------- ! NONE ! IMPLICIT ARGUMENTS : ! -------------------- ! COMMONS YOERAD, YOERDU ! METHOD. ! ------- ! SEE DOCUMENTATION ! EXTERNALS. ! ---------- ! SUAER, SUAERH, SUAERV, SULW, SUSW, SUOCST, SUSAT ! SUAERL, SUAERSN, SUSRTAER, SRTM_INIT, SUSRTCOP ! REFERENCE. ! ---------- ! ECMWF Research Department documentation of the IFS ! AUTHOR. ! ------- ! JEAN-JACQUES MORCRETTE *ECMWF* ! MODIFICATIONS. ! -------------- ! ORIGINAL : 88-12-15 ! P.COURTIER AND M.HAMRUD NAME SURAD ALREADY USED ! Modified 93-11-15 by Ph. Dandin : FMR scheme with MF ! Modified 95-12 by PhD : Cloud overlapping hypothesis for FMR ! 980317 JJMorcrette clean-up (NRAD, NFLUX) ! 000118 JJMorcrette variable concentr. uniformly mixed gases ! 990525 JJMorcrette GISS volcanic and new tropospheric aerosols ! 990831 JJMorcrette RRTM ! R. El Khatib 01-02-02 proper initialization of NFRRC moved in SUCFU ! 010129 JJMorcrette clean-up LERAD1H, NLNGR1H ! 011105 GMozdzynski support new radiation grid ! 011005 JJMorcrette CCN --> Re Water clouds ! R. El Khatib 01-02-02 LRRTM=lecmwf by default ! 020909 GMozdzynski support NRADRES to specify radiation grid ! 021001 GMozdzynski support on-demand radiation communications ! 030422 GMozdzynski automatic min-halo ! 030501 JJMorcrette new radiation grid on, new aerosols on (default) ! 030513 JJMorcrette progn. O3 / radiation interactions off (default) ! M.Hamrud 01-Oct-2003 CY28 Cleaning ! 050315 JJMorcrette prog.aerosols v1 ! 041214 JJMorcrette SRTM ! 050111 JJMorcrette new cloud optical properties ! 050415 GMozdzynski Reduced halo support for radiation interpolation ! 051004 JJMorcrette UV surface radiation processor ! 051220 JJMorcrette SRTM112g+LWSCAT+UVprocessor+(bgfx:swclr, radaca) ! 060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse) ! 060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse) ! JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation ! 060625 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse) ! 060726 JJMorcrette McICA default operational configuration ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK USE PARDIM , ONLY : JPMXGL USE PARRRTM , ONLY : JPLAY USE PARSRTM , ONLY : JPGPT USE YOMCT0 , ONLY : LOUTPUT ,NPRINTLEV,LALLOPR,& & NPROC ,N_REGIONS_NS ,N_REGIONS_EW USE YOMDIM , ONLY : NDLON ,NSMAX ,NDGENL ,& & NDGSAL ,NDGLG ,NDGSAG ,NDGENG ,NDSUR1 ,& & NDLSUR ,NDGSUR ,NGPBLKS ,NFLEVG ,NPROMA USE YOMCT0B , ONLY : LECMWF USE YOMDYN , ONLY : TSTEP ! Ce qui concerne NULRAD commente par MPL le 15.04.09 !USE YOMLUN , ONLY : NULNAM ,NULRAD ,NULOUT USE YOMLUN , ONLY : NULRAD ,NULOUT USE YOMCST , ONLY : RDAY ,RG ,RCPD ,RPI ,RI0 USE YOMPHY , ONLY : LMPHYS, LRAYFM ,LRAYFM15 USE YOEPHY , ONLY : LEPHYS ,LERADI, LE4ALB USE YOERDI , ONLY : RCCO2, RCCH4, RCN2O, RCCFC11, RCCFC12, RSOLINC USE YOERAD , ONLY : NAER , NOZOCL ,& & NRADFR ,NRADPFR ,NRADPLA ,NRINT ,& & NRADNFR ,NRADSFR ,NOVLP ,NRPROMA ,& !& NLW ,NSW ,NTSW ,NCSRADF ,& ! NSW mis dans .def MPL 20140211 & NLW ,NTSW ,NCSRADF ,& & NMODE ,NLNGR1H ,NSWNL ,NSWTL ,NUV ,& & LERAD1H ,LERADHS ,LEPO3RA ,LRADLB ,LONEWSW ,& & LCCNL ,LCCNO ,& & LECSRAD ,LHVOLCA ,LNEWAER ,LRRTM ,LSRTM ,LDIFFC ,& & NRADINT ,NRADRES ,CRTABLEDIR,CRTABLEFIL ,& & NICEOPT ,NLIQOPT ,NRADIP ,NRADLP ,NINHOM ,NLAYINH ,& & LRAYL ,LOPTRPROMA,& & RCCNLND ,RCCNSEA ,RLWINHF ,RSWINHF ,RRe2De ,& & RPERTOZ ,NPERTOZ ,NMCICA ,& & LNOTROAER,NPERTAER ,LECO2VAR ,LHGHG ,NHINCSOL,NSCEN ,& & LEDBUG USE YOERDU , ONLY : NUAER ,NTRAER ,RCDAY ,R10E ,& & REPLOG ,REPSC ,REPSCO ,REPSCQ ,REPSCT ,& & REPSCW ,DIFF USE YOEAERD , ONLY : CVDAES ,CVDAEL ,CVDAEU ,CVDAED ,& & RCAEOPS ,RCAEOPL ,RCAEOPU ,RCAEOPD ,RCTRBGA ,& & RCVOBGA ,RCSTBGA ,RCTRPT ,RCAEADM ,RCAEROS , & & RCAEADK USE YOE_UVRAD, ONLY : JUVLAM, LUVPROC, LUVTDEP, LUVDBG, NRADUV, NUVTIM, RUVLAM, RMUZUV USE YOMMP , ONLY : MYPROC ,NPRCIDS ,LSPLIT ,NAPSETS ,& & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,& & NSTA,NONL,NPTRFRSTLAT,NFRSTLAT,NLSTLAT ,& & MY_REGION_NS ,MY_REGION_EW ,NGLOBALINDEX ,& & NRISTA ,NRIONL ,NRIOFF ,NRIEXT ,NRICORE ,& & NRISENDPOS ,NRIRECVPOS ,NRISENDPTR ,NRIRECVPTR ,& & NARIB1 ,NRIPROCS ,NRIMPBUFSZ,NRISPT ,NRIRPT ,& & NRICOMM ,& & NROSTA ,NROONL ,NROOFF ,NROEXT ,NROCORE ,& & NROSENDPOS ,NRORECVPOS ,NROSENDPTR ,NRORECVPTR ,& & NAROB1 ,NROPROCS ,NROMPBUFSZ,NROSPT ,NRORPT ,& & NROCOMM USE YOMGC , ONLY : GELAT ,GELAM USE YOMLEG , ONLY : RMU ,RSQM2 USE YOMSC2 , ONLY : & & NRIWIDEN ,NRIWIDES ,NRIWIDEW ,NRIWIDEE,& & NROWIDEN ,NROWIDES ,NROWIDEW ,NROWIDEE USE YOMGEM , ONLY : NGPTOT ,NGPTOTG ,NGPTOTMX ,NLOENG USE YOMTAG , ONLY : MTAGRAD USE YOMPRAD , ONLY : LODBGRADI,LODBGRADL ,RADGRID ,& & LRADONDEM USE YOMRADF , ONLY : EMTD ,TRSW ,EMTC ,TRSC ,& & SRSWD ,SRLWD ,SRSWDCS ,SRLWDCS ,SRSWDV ,& & SRSWDUV ,EDRO ,SRSWPAR ,SRSWUVB ,SRSWPARC, SRSWTINC,& & EMTU, RMOON ! Commente par MPL 26.11.08 !USE YOPHNC , ONLY : LERADN2 ! MPLefebvre 6-11-08 commente tout ce qui concerne MPL_MODULE !USE MPL_MODULE , ONLY : MPL_BROADCAST, MPL_SEND, MPL_RECV USE YOM_YGFL , ONLY : YO3 !!!!! A REVOIR (MPL) NDLNPR devrait etre initialise dans sudyn.F90 USE YOMDYN , ONLY : NDLNPR ! Temporary fix waiting for cleaner interface (or not) USE clesphys_mod_h, ONLY: NSW, CFC11_ppt, CFC12_ppt, CH4_ppb, CO2_ppm, iflag_rrtm, N2O_ppb, overlap IMPLICIT NONE INTEGER(KIND=JPIM),INTENT(IN) :: KLEV INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT REAL(KIND=JPRB) ,INTENT(IN) :: PETAH(KLEV+1) ! LOCAL ARRAYS FOR THE PURPOSE OF READING NAMRGRI (RADIATION GRID) INTEGER(KIND=JPIM) :: NRGRI(JPMXGL) INTEGER(KIND=JPIM) :: IDGL,INBLW,IRADFR,IST1HR,ISTNHR,IDIR,IFIL INTEGER(KIND=JPIM) :: IRIRPTSUR,IRISPTSUR,IRIMAPLEN INTEGER(KIND=JPIM) :: JLON,JGLAT,JGL,JGLSUR,IDLSUR,IOFF,ILAT,ISTLON,IENDLON INTEGER(KIND=JPIM) :: IRORPTSUR,IROSPTSUR,IROMAPLEN INTEGER(KIND=JPIM) :: ILBRLATI,IUBRLATI,IGLGLO,IDUM,IU INTEGER(KIND=JPIM) :: J,JROC,IGPTOT INTEGER(KIND=JPIM) :: IROWIDEMAXN,IROWIDEMAXS,IROWIDEMAXW,IROWIDEMAXE INTEGER(KIND=JPIM) :: IRIWIDEMAXN,IRIWIDEMAXS,IRIWIDEMAXW,IRIWIDEMAXE INTEGER(KIND=JPIM) :: IARIB1MAX,IAROB1MAX INTEGER(KIND=JPIM) :: IWIDE(10) INTEGER(KIND=JPIM) :: ILATS_DIFF_F,ILATS_DIFF_C INTEGER(KIND=JPIM), PARAMETER :: JP_MIN_HALO=5 INTEGER(KIND=JPIM) :: ISW,JUV,IDAYUV LOGICAL :: LLINEAR_GRID LOGICAL :: LLDEBUG,LLP REAL(KIND=JPRB) :: ZSTPHR, ZTSTEP, ZGEMU, ZLON, ZD1, ZD2, ZD3, ZD4, ZD5, ZD6 REAL(KIND=JPRB) :: ZMINRADLAT,ZMAXRADLAT,ZMINRADLON,ZMAXRADLON REAL(KIND=JPRB) :: ZMINMDLLAT,ZMAXMDLLAT,ZMINMDLLON,ZMAXMDLLON REAL(KIND=JPRB) :: ZLAT !REAL(KIND=JPRB) :: RLATVOL, RLONVOL CHARACTER (LEN = 300) :: CLFN INTEGER(KIND=JPIM), PARAMETER :: JPIOMASTER=1 INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPOS(:) INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPOS(:) INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPTR(:) INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPTR(:) INTEGER(KIND=JPIM), ALLOCATABLE :: IRICOMM(:) INTEGER(KIND=JPIM), ALLOCATABLE :: IRIMAP(:,:) INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPOS(:) INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPOS(:) INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPTR(:) INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPTR(:) INTEGER(KIND=JPIM), ALLOCATABLE :: IROCOMM(:) INTEGER(KIND=JPIM), ALLOCATABLE :: IROMAP(:,:) INTEGER(KIND=JPIM), ALLOCATABLE :: IGLOBALINDEX(:) REAL(KIND=JPRB),ALLOCATABLE :: ZLATX(:) REAL(KIND=JPRB),ALLOCATABLE :: ZLONX(:) REAL(KIND=JPRB) :: ZHOOK_HANDLE INTERFACE #include "setup_trans.h" #include "trans_inq.h" END INTERFACE #include "abor1.intfb.h" #include "posnam.intfb.h" #include "rrtm_init_140gp.intfb.h" #include "rdcset.intfb.h" #include "suaerh.intfb.h" #include "suaerl.intfb.h" #include "suaersn.intfb.h" #include "suaerv.intfb.h" #include "suclopn.intfb.h" #include "suecradi.intfb.h" #include "suecradl.intfb.h" #include "sulwn.intfb.h" #include "sulwneur.intfb.h" #include "suovlp.intfb.h" #include "surdi.intfb.h" #include "surrtab.intfb.h" #include "surrtftr.intfb.h" #include "surrtpk.intfb.h" #include "surrtrf.intfb.h" #include "susat.intfb.h" #include "suswn.intfb.h" #include "susrtaer.intfb.h" #include "srtm_init.intfb.h" #include "susrtcop.intfb.h" #include "su_aerw.intfb.h" #include "su_uvrad.intfb.h" #include "su_mcica.intfb.h" ! ---------------------------------------------------------------- !#include "clesphys.h" #include "naerad.h" #include "namrgri.h" !MPL/IM 20160915 on prend GES de phylmd !* 1. INITIALIZE NEUROFLUX LONGWAVE RADIATION ! --------------------------------------- IF (LHOOK) CALL DR_HOOK('SUECRAD',0,ZHOOK_HANDLE) !CALL GSTATS(1818,0) MPL 2.12.08 !IF (LERADN2) THEN ! CALL SULWNEUR(KLEV) !ENDIF !* 2. SET DEFAULT VALUES. ! ------------------- !* 2.1 PRESET INDICES IN *YOERAD* ! -------------------------- LERAD1H=.FALSE. NLNGR1H=6 LERADHS=.TRUE. LONEWSW=.TRUE. LECSRAD=.FALSE. !LE4ALB=.FALSE. !This is read from SU0PHY in NAEPHY and put in YOEPHY !- default setting of cloud optical properties ! liquid water cloud 0: Fouquart (SW), Smith-Shi (LW) ! 1: Slingo (SW), Savijarvi (LW) ! 2: Slingo (SW), Lindner-Li (LW) ! ice water cloud 0: Ebert-Curry (SW), Smith-Shi (LW) ! 1: Ebert-Curry (SW), Ebert-Curry (LW) ! 2: Fu-Liou'93 (SW), Fu-Liou'93 (LW) ! 3: Fu'96 (SW), Fu et al'98 (LW) NLIQOPT=2 ! before 3?R1 default=0 2 NICEOPT=3 ! before 3?R1 default=1 3 !- default setting of cloud effective radius/diameter ! liquid water cloud 0: f(P) 10 to 45 ! 1: 13: ocean; 10: land ! 2: Martin et al. CCN 50 over ocean, 900 over land ! ice water cloud 0: 40 microns ! 1: f(T) 40 to 130 microns ! 2: f(T) 30 to 60 ! 3: f(T,IWC) Sun'01: 22.5 to 175 microns ! conversion factor between effective radius and particle size for ice NRADIP=3 ! before 3?R1 default=2 3 NRADLP=2 ! before 3?R1 default=2 2 print *,'SUECRAD: NRADLP, NRADIP=',NRADLP,NRADIP RRe2De=0.64952_JPRB ! before 3?R1 default=0.5_JPRB !- RRTM as LW scheme LRRTM = .FALSE. LECMWF = .FALSE. IF (iflag_rrtm.EQ.1) THEN LRRTM = .TRUE. LECMWF = .TRUE. ! LRRTM = .FALSE. ! Utiliser pour faire tourner le "vieux" rayonnement ! LECMWF = .FALSE. ENDIF !LRRTM = .FALSE. !- SRTM as SW scheme !!!!! A REVOIR (MPL) verifier signification de LSRTM LSRTM = .FALSE. ! before 3?R1 default was .FALSE. true ! -- McICA treatment of cloud-radiation interactions ! - 1 is maximum-random, 2 is generalized cloud overlap (before 31R1 default=0 no McICA) NMcICA = 2 ! 2 for generalized overlap !- Inhomogeneity factors in LW and SW (0=F, 1=0.7 in both, 2=Barker's, 3=Cairns) NINHOM = 0 ! before 3?R1 default=1 NLAYINH= 0 RLWINHF = 1.0_JPRB ! before 3?R1 default=0.7 RSWINHF = 1.0_JPRB ! before 3?R1 default=0.7 !- Diffusivity correction a la Savijarvi LDIFFC = .FALSE. ! before 31R1 default=.FALSE. !- history of volcanic aerosols LHVOLCA=.FALSE. !- monthly climatol. of tropospheric aerosols from Tegen et al. (1997) LNEWAER=.TRUE. !!! cpl LNOTROAER=.FALSE. LNOTROAER=.TRUE. NPERTAER=0 !- New Rayleigh formulation LRAYL=.TRUE. !- Number concentration of aerosols if specified LCCNL=.TRUE. ! before 3?R1 default=.FALSE. true LCCNO=.TRUE. ! before 3?R1 default=.FALSE. true RCCNLND=900._JPRB ! before 3?R1 default=900. now irrelevant RCCNSEA=50._JPRB ! before 3?R1 default=50. now irrelevant !- interaction radiation / prognostic O3 off by default LEPO3RA=.FALSE. print *,'SUECRAD-0' IF (.NOT.YO3%LGP) THEN LEPO3RA=.FALSE. ENDIF RPERTOZ=0._JPRB NPERTOZ=0 !NAER: CONFIGURATION INDEX FOR AEROSOLS !!!!! A REVOIR (MPL) a mettre dans un fichier .def NAER =1 NMODE =0 NOZOCL =1 NRADFR =-3 IF (NSMAX >= 511) NRADFR =-1 NRADPFR=0 NRADPLA=15 ! -- UV diagnostic of surface fluxes over the 280-400 nm interval ! with up-to 24 values (5 nm wide spectral intervals) LUVPROC=.FALSE. LUVTDEP=.TRUE. LUVDBG =.FALSE. NRADUV =-3 NUVTIM = 0 NUV = 24 RMUZUV = 1.E-01_JPRB DO JUV=1,NUV RUVLAM(JUV)=280._JPRB+(JUV-1)*5._JPRB ENDDO !- radiation interpolation (George M's grid on by default) LLDEBUG=.TRUE. LEDBUG=.FALSE. NRADINT=3 NRADRES=0 NRINT =4 LRADLB=.TRUE. CRTABLEDIR='./' CRTABLEFIL='not set' LRADONDEM=.TRUE. !GM Temporary as per trans/external/setup_trans.F90 LLINEAR_GRID=NSMAX > (NDLON+3)/3 IF( LLDEBUG )THEN WRITE(NULOUT,'("SUECRAD: NSMAX=",I6)')NSMAX WRITE(NULOUT,'("SUECRAD: NDLON=",I6)')NDLON WRITE(NULOUT,'("SUECRAD: LLINEAR_GRID=",L5)')LLINEAR_GRID ENDIF NUAER = 24 NTRAER = 15 ! 1: max-random, 2: max, 3: random (5,6,7,8 pour meso-NH) ! le CASE qui suit car les conventions sont differentes dans ARP et LMDZ (MPL 20100415) SELECT CASE (overlap) CASE (:1) NOVLP = 2 CASE (2) NOVLP = 3 CASE (3:) NOVLP = 1 END SELECT print *,'SUECRAD: NOVLP=',NOVLP NLW = 16 NTSW = 14 !NSW = 6 !!!!! Maintenant dans config.def (MPL 20140213) NSWNL = 6 NSWTL = 2 NCSRADF= 1 IF(NSMAX >= 106) THEN NRPROMA = 80 ELSEIF(NSMAX == 63) THEN NRPROMA=48 ELSE NRPROMA=64 ENDIF !* 2.3 SET SECURITY PARAMETERS ! ----------------------- REPSC = 1.E-04_JPRB REPSCO = 1.E-12_JPRB REPSCQ = 1.E-12_JPRB REPSCT = 1.E-12_JPRB REPSCW = 1.E-12_JPRB REPLOG = 1.E-12_JPRB !* 2.4 BACKGROUND GAS CONCENTRATIONS (IPCC/SACC, 1990) ! ----------------------------------------------- LECO2VAR=.FALSE. LHGHG =.FALSE. NHINCSOL= 0 NSCEN = 1 RSOLINC = RI0 ! Valeurs d origine MPL 18052010 !RCCO2 = 353.E-06_JPRB !RCCH4 = 1.72E-06_JPRB !RCN2O = 310.E-09_JPRB !RCCFC11 = 280.E-12_JPRB !RCCFC12 = 484.E-12_JPRB ! Valeurs LMDZ (physiq.def) MPL 18052010 !RCCO2 = 348.E-06_JPRB !RCCH4 = 1.65E-06_JPRB !RCN2O = 306.E-09_JPRB !RCCFC11 = 280.E-12_JPRB !RCCFC12 = 484.E-12_JPRB !MPL/IM 20160915 on prend GES de phylmd RCCO2 = CO2_ppm * 1.0e-06 RCCH4 = CH4_ppb * 1.0e-09 RCN2O = N2O_ppb * 1.0e-09 RCCFC11 = CFC11_ppt * 1.0e-12 RCCFC12 = CFC12_ppt * 1.0e-12 !print *,'LMDZSUECRAD-1 RCCO2=',RCCO2 !print *,'LMDZSUECRAD-1 RCCH4=',RCCH4 !print *,'LMDZSUECRAD-1 RCN2O=',RCN2O !print *,'LMDZSUECRAD-1 RCCFC11=',RCCFC11 !print *,'LMDZSUECRAD-1 RCCFC12=',RCCFC12 ! ------------------------------------------------------------------ !* 3. READ VALUES OF RADIATION CONFIGURATION ! -------------------------------------- !CALL POSNAM(NULNAM,'NAERAD') !READ (NULNAM,NAERAD) print *,'SUECRAD-2' !CALL POSNAM(NULNAM,'NAEAER') !READ (NULNAM,NAEAER) !IF (NTYPAER(9) /= 0) THEN ! RGEMUV=(RLATVOL+90._JPRB)*RPI/180._JPRB ! RGELAV=RLONVOL*RPI/180._JPRB ! RCLONV=COS(RGELAV) ! RSLONV=SIN(RGELAV) ! DO J=1,NGPTOT-1 ! IF (RGELAV > GELAM(J) .AND. RGELAV <= GELAM(J+1) .AND. & ! & RGEMUV < RMU(JL) .AND. RGEMUV >= RMU(JL+1) ) THEN ! RDGMUV=ABS( RMU(J+1) - RMU(J)) ! RDGLAV=ABS( GELAM(J+1)-GELAM(J) ) ! RDSLONV=ABS( SIN(GELAM(JL+1))-SIN(GELAM(JL)) ) ! RDCLONV=ABS( COS(GELAM(JL+1))-COS(GELAM(JL)) ) ! END IF ! END DO !END IF !- reset some parameters if SW6 is used (revert to pre-CY3?R1 operational configuration) IF (.NOT.LSRTM) THEN NMcICA = 0 LCCNL = .FALSE. LCCNO = .FALSE. LDIFFC = .FALSE. NICEOPT= 1 NLIQOPT= 0 NRADIP = 4 NRADLP = 3 RRe2De = 0.5_JPRB NINHOM = 1 RLWINHF= 0.7_JPRB RSWINHF= 0.7_JPRB ENDIF print *,'SUECRAD-3' !- for McICA computations, make sure these parameters are as follows ... IF (NMCICA /= 0) THEN NINHOM = 0 RLWINHF= 1.0_JPRB RSWINHF= 1.0_JPRB !-- read the XCW values for Raisanen-Cole-Barker cloud generator CALL SU_McICA ENDIF print *,'SUECRAD-4' IF( LLDEBUG )THEN WRITE(NULOUT,'("SUECRAD: NRADINT=",I2)')NRADINT WRITE(NULOUT,'("SUECRAD: NRADRES=",I4)')NRADRES ENDIF ! DETERMINE WHETHER NRPROMA IS NEGATIVE AND SET LOPTRPROMA LOPTRPROMA=NRPROMA > 0 NRPROMA=ABS(NRPROMA) IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")') NRADINT=0 ENDIF IF( NRADINT > 0 .AND. LRAYFM .AND. NAER /= 0 .AND. .NOT.LHVOLCA )THEN ! This combination is not supported as aerosol data would be ! required to be interpolated (see radintg) WRITE(NULOUT,'("SUECRAD: NRADINT>0, LRAYFM=T NAER /= 0 .AND. LHVOLCA=F,",& & " NRADRES RESET TO NSMAX (NO INTERPOLATION)")') NRADRES=NSMAX ENDIF !CALL GSTATS(1818,1) MPL 2.12.08 100 CONTINUE IF( LERADI )THEN ! START OF LERADI BLOCK IF( NRADINT == -1 )THEN ! INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION LODBGRADI=.FALSE. CALL SUECRADI ! INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION COURSE GRID ! LOAD BALANCING LODBGRADL=.FALSE. ! CALL SUECRADL ! MPL 1.12.08 CALL ABOR1('JUSTE APRES CALL SUECRADL COMMENTE') ELSEIF( NRADINT == 0 )THEN IF( NRADRES /= NSMAX )THEN WRITE(NULOUT,'("SUECRAD: NRADINT=0 REQUESTED, NRADRES RESET TO NSMAX")') NRADRES=NSMAX ENDIF RADGRID%NGPTOT=NGPTOT NARIB1=0 NAROB1=0 ELSEIF( NRADINT >=1 .AND. NRADINT <= 3 )THEN NARIB1=0 NAROB1=0 ! set the default radiation grid resolution for the current model resolution ! if not already specified IF( NRADRES == 0 )THEN IF( LLINEAR_GRID )THEN ! RATIO OF GRID-POINTS (MODEL/RAD) IF( NSMAX == 63 )THEN NRADRES=21 ! 3.62 LLINEAR_GRID=.FALSE. ENDIF IF( NSMAX == 95 ) NRADRES= 95 ! 1.00 IF( NSMAX == 159 ) NRADRES= 63 ! 5.84 IF( NSMAX == 255 ) NRADRES= 95 ! 6.69 IF( NSMAX == 319 ) NRADRES= 159 ! 3.87 IF( NSMAX == 399 ) NRADRES= 159 ! 5.99 IF( NSMAX == 511 ) NRADRES= 255 ! 3.92 IF( NSMAX == 639 ) NRADRES= 319 ! 3.92 IF( NSMAX == 799 ) NRADRES= 399 ! 3.94 IF( NSMAX == 1023 ) NRADRES= 511 ! 3.94 IF( NSMAX == 1279 ) NRADRES= 639 ! IF( NSMAX == 2047 ) NRADRES= 1023 ! ELSE ! NOT LINEAR GRID IF( NSMAX == 21 ) NRADRES= 21 ! 1.00 IF( NSMAX == 42 ) NRADRES= 21 ! 3.62 IF( NSMAX == 63 ) NRADRES= 42 ! 2.17 IF( NSMAX == 106 ) NRADRES= 63 ! 2.69 IF( NSMAX == 170 ) NRADRES= 63 ! 6.69 IF( NSMAX == 213 ) NRADRES= 106 ! 3.87 IF( NSMAX == 266 ) NRADRES= 106 ! 5.99 IF( NSMAX == 341 ) NRADRES= 170 ! 3.92 IF( NSMAX == 426 ) NRADRES= 213 ! 3.92 IF( NSMAX == 533 ) NRADRES= 266 ! 3.94 IF( NSMAX == 682 ) NRADRES= 341 ! 3.94 ENDIF ENDIF print *,'SUECRAD-5' ! test if radiation grid resolution has been set IF( NRADRES == 0 )THEN WRITE(NULOUT,'("SUECRAD: NRADRES NOT SET OR DEFAULT FOUND,NSMAX=",I4)')NSMAX CALL ABOR1('SUECRAD: NRADRES NOT SET OR DEFAULT FOUND') ENDIF ! test if no interpolation is required IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")') NRADINT=0 GOTO 100 ENDIF ! CALL GSTATS(1818,0) MPL 2.12.08 IF( CRTABLEFIL == 'not set' )THEN IF( LLINEAR_GRID )THEN IF( NRADRES < 1000 )THEN WRITE(CRTABLEFIL,'("rtablel_2",I3.3)')NRADRES ELSE WRITE(CRTABLEFIL,'("rtablel_2",I4.4)')NRADRES ENDIF ELSE IF( NRADRES < 1000 )THEN WRITE(CRTABLEFIL,'("rtable_2" ,I3.3)')NRADRES ELSE WRITE(CRTABLEFIL,'("rtable_2" ,I4.4)')NRADRES ENDIF ENDIF ENDIF ! CALL GSTATS(1818,1) MPL 2.12.08 RADGRID%NSMAX=NRADRES IF( MYPROC == JPIOMASTER )THEN IDIR=LEN_TRIM(CRTABLEDIR) IFIL=LEN_TRIM(CRTABLEFIL) CLFN=CRTABLEDIR(1:IDIR)//CRTABLEFIL(1:IFIL) ! Ce qui concerne NULRAD commente par MPL le 15.04.09 ! OPEN(NULRAD,FILE=CLFN,ACTION="READ",ERR=999) ! GOTO 1000 ! 999 CONTINUE ! WRITE(NULOUT,'("SUECRAD: UNABLE TO OPEN FILE ",A)')CLFN ! CALL ABOR1('SUECRAD: UNABLE TO OPEN RADIATION GRID RTABLE FILE') ! 1000 CONTINUE NRGRI(:)=0 ! Ce qui concerne NAMRGRI commente par MPL le 15.04.09 ! CALL POSNAM(NULRAD,'NAMRGRI') ! READ (NULRAD,NAMRGRI) IDGL=1 DO WHILE( NRGRI(IDGL)>0 ) IF( LLDEBUG )THEN WRITE(NULOUT,'("SUECRAD: NRGRI(",I4,")=",I4)')IDGL,NRGRI(IDGL) ENDIF IDGL=IDGL+1 ENDDO IDGL=IDGL-1 RADGRID%NDGLG=IDGL IF( LLDEBUG )THEN WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG=",I4)')RADGRID%NDGLG ENDIF ! CLOSE(NULRAD) ENDIF ! CALL GSTATS(667,0) MPL 2.12.08 IF( NPROC > 1 )THEN stop 'Pas pret pour proc > 1' ! CALL MPL_BROADCAST (RADGRID%NDGLG,MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:') ENDIF ALLOCATE(RADGRID%NRGRI(RADGRID%NDGLG)) IF( MYPROC == JPIOMASTER )THEN RADGRID%NRGRI(1:RADGRID%NDGLG)=NRGRI(1:RADGRID%NDGLG) ENDIF IF( NPROC > 1 )THEN stop 'Pas pret pour proc > 1' ! CALL MPL_BROADCAST (RADGRID%NRGRI(1:RADGRID%NDGLG),MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:') ENDIF ! CALL GSTATS(667,1) MPL 2.12.08 ! CALL GSTATS(1818,0) MPL 2.12.08 IF ( NRADINT == 1 )THEN WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - SPECTRAL TRANSFORM")') RADGRID%NDGSUR=0 NRIWIDEN=0 NRIWIDES=0 NRIWIDEW=0 NRIWIDEE=0 NROWIDEN=0 NROWIDES=0 NROWIDEW=0 NROWIDEE=0 ELSEIF( NRADINT == 2 )THEN WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 4 POINT")') RADGRID%NDGSUR=2 ELSEIF( NRADINT == 3 )THEN WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 12 POINT")') RADGRID%NDGSUR=2 ENDIF WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSUR =",I8)')RADGRID%NDGSUR RADGRID%NDGSAG=1-RADGRID%NDGSUR RADGRID%NDGENG=RADGRID%NDGLG+RADGRID%NDGSUR RADGRID%NDLON=RADGRID%NRGRI(RADGRID%NDGLG/2) WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAG =",I8)')RADGRID%NDGSAG WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENG =",I8)')RADGRID%NDGENG WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG =",I8)')RADGRID%NDGLG WRITE(NULOUT,'("SUECRAD: RADGRID%NDLON =",I8)')RADGRID%NDLON CALL FLUSH(NULOUT) ALLOCATE(RADGRID%NLOENG(RADGRID%NDGSAG:RADGRID%NDGENG)) RADGRID%NLOENG(1:RADGRID%NDGLG)=RADGRID%NRGRI(1:RADGRID%NDGLG) IF(RADGRID%NDGSUR >= 1)THEN DO JGLSUR=1,RADGRID%NDGSUR RADGRID%NLOENG(1-JGLSUR)=RADGRID%NLOENG(JGLSUR) ENDDO DO JGLSUR=1,RADGRID%NDGSUR RADGRID%NLOENG(RADGRID%NDGLG+JGLSUR)=RADGRID%NLOENG(RADGRID%NDGLG+1-JGLSUR) ENDDO ENDIF ! CALL GSTATS(1818,1) MPL 2.12.08 ! Setup the transform package for the radiation grid CALL SETUP_TRANS (KSMAX=RADGRID%NSMAX, & & KDGL=RADGRID%NDGLG, & & KLOEN=RADGRID%NLOENG(1:RADGRID%NDGLG), & & LDLINEAR_GRID=LLINEAR_GRID, & & LDSPLIT=LSPLIT, & & KAPSETS=NAPSETS, & & KRESOL=RADGRID%NRESOL_ID) ALLOCATE(RADGRID%NSTA(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW)) ALLOCATE(RADGRID%NONL(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW)) ALLOCATE(RADGRID%NPTRFRSTLAT(N_REGIONS_NS)) ALLOCATE(RADGRID%NFRSTLAT(N_REGIONS_NS)) ALLOCATE(RADGRID%NLSTLAT(N_REGIONS_NS)) ALLOCATE(RADGRID%RMU(RADGRID%NDGSAG:RADGRID%NDGENG)) ALLOCATE(RADGRID%RSQM2(RADGRID%NDGSAG:RADGRID%NDGENG)) ALLOCATE(RADGRID%RLATIG(RADGRID%NDGSAG:RADGRID%NDGENG)) ! Interrogate the transform package for the radiation grid ! CALL GSTATS(1818,0) MPL 2.12.08 CALL TRANS_INQ (KRESOL =RADGRID%NRESOL_ID, & & KSPEC2 =RADGRID%NSPEC2, & & KNUMP =RADGRID%NUMP, & & KGPTOT =RADGRID%NGPTOT, & & KGPTOTG =RADGRID%NGPTOTG, & & KGPTOTMX =RADGRID%NGPTOTMX, & & KPTRFRSTLAT=RADGRID%NPTRFRSTLAT, & & KFRSTLAT =RADGRID%NFRSTLAT, & & KLSTLAT =RADGRID%NLSTLAT, & & KFRSTLOFF =RADGRID%NFRSTLOFF, & & KSTA =RADGRID%NSTA(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), & & KONL =RADGRID%NONL(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), & & KPTRFLOFF =RADGRID%NPTRFLOFF, & & PMU =RADGRID%RMU(1:) ) IF( NRADINT == 2 .OR. NRADINT == 3 )THEN DO JGL=1,RADGRID%NDGLG RADGRID%RSQM2(JGL) = SQRT(1.0_JPRB - RADGRID%RMU(JGL)*RADGRID%RMU(JGL)) RADGRID%RLATIG(JGL) = ASIN(RADGRID%RMU(JGL)) ! WRITE(NULOUT,'("SUECRAD: JGL=",I6," RADGRID%RLATIG=",F10.3)')& ! & JGL,RADGRID%RLATIG(JGL) ENDDO IF(RADGRID%NDGSUR >= 1)THEN DO JGLSUR=1,RADGRID%NDGSUR RADGRID%RMU(1-JGLSUR)=RADGRID%RMU(JGLSUR) RADGRID%RSQM2(1-JGLSUR)=RADGRID%RSQM2(JGLSUR) RADGRID%RLATIG(1-JGLSUR)=RPI-RADGRID%RLATIG(JGLSUR) ENDDO DO JGLSUR=1,RADGRID%NDGSUR RADGRID%RMU(RADGRID%NDGLG+JGLSUR)=RADGRID%RMU(RADGRID%NDGLG+1-JGLSUR) RADGRID%RSQM2(RADGRID%NDGLG+JGLSUR)=RADGRID%RSQM2(RADGRID%NDGLG+1-JGLSUR) RADGRID%RLATIG(RADGRID%NDGLG+JGLSUR)=-RPI-RADGRID%RLATIG(RADGRID%NDGLG+1-JGLSUR) ENDDO ENDIF ENDIF RADGRID%NDGSAL=1 RADGRID%NDGENL=RADGRID%NLSTLAT(MY_REGION_NS)-RADGRID%NFRSTLOFF RADGRID%NDSUR1=3-MOD(RADGRID%NDLON,2) IDLSUR=MAX(RADGRID%NDLON,2*RADGRID%NSMAX+1) RADGRID%NDLSUR=IDLSUR+RADGRID%NDSUR1 RADGRID%MYFRSTACTLAT=RADGRID%NFRSTLAT(MY_REGION_NS) RADGRID%MYLSTACTLAT=RADGRID%NLSTLAT(MY_REGION_NS) WRITE(NULOUT,'("SUECRAD: RADGRID%NRESOL_ID =",I8)')RADGRID%NRESOL_ID WRITE(NULOUT,'("SUECRAD: RADGRID%NSMAX =",I8)')RADGRID%NSMAX WRITE(NULOUT,'("SUECRAD: RADGRID%NSPEC2 =",I8)')RADGRID%NSPEC2 WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOT =",I8)')RADGRID%NGPTOT WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOTG =",I8)')RADGRID%NGPTOTG WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAL =",I8)')RADGRID%NDGSAL WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENL =",I8)')RADGRID%NDGENL WRITE(NULOUT,'("SUECRAD: RADGRID%NDSUR1 =",I8)')RADGRID%NDSUR1 WRITE(NULOUT,'("SUECRAD: RADGRID%NDLSUR =",I8)')RADGRID%NDLSUR WRITE(NULOUT,'("SUECRAD: RADGRID%MYFRSTACTLAT =",I8)')RADGRID%MYFRSTACTLAT WRITE(NULOUT,'("SUECRAD: RADGRID%MYLSTACTLAT =",I8)')RADGRID%MYLSTACTLAT CALL FLUSH(NULOUT) ALLOCATE(RADGRID%NASM0(0:RADGRID%NSPEC2)) ALLOCATE(RADGRID%MYMS(RADGRID%NUMP)) CALL TRANS_INQ (KRESOL =RADGRID%NRESOL_ID, & & KASM0 =RADGRID%NASM0, & & KMYMS =RADGRID%MYMS ) ALLOCATE(RADGRID%GELAM(RADGRID%NGPTOT)) ALLOCATE(RADGRID%GELAT(RADGRID%NGPTOT)) ALLOCATE(RADGRID%GESLO(RADGRID%NGPTOT)) ALLOCATE(RADGRID%GECLO(RADGRID%NGPTOT)) ALLOCATE(RADGRID%GEMU (RADGRID%NGPTOT)) IOFF=0 ILAT=RADGRID%NPTRFLOFF DO JGLAT=RADGRID%NFRSTLAT(MY_REGION_NS), & & RADGRID%NLSTLAT(MY_REGION_NS) ZGEMU=RADGRID%RMU(JGLAT) ILAT=ILAT+1 ISTLON = RADGRID%NSTA(ILAT,MY_REGION_EW) IENDLON = ISTLON-1 + RADGRID%NONL(ILAT,MY_REGION_EW) DO JLON=ISTLON,IENDLON ZLON= REAL(JLON-1,JPRB)*2.0_JPRB*RPI & & /REAL(RADGRID%NLOENG(JGLAT),JPRB) IOFF=IOFF+1 RADGRID%GELAM(IOFF) = ZLON RADGRID%GELAT(IOFF) = ASIN(ZGEMU) RADGRID%GESLO(IOFF) = SIN(ZLON) RADGRID%GECLO(IOFF) = COS(ZLON) RADGRID%GEMU (IOFF) = ZGEMU ENDDO ENDDO IF( NRADINT == 2 .OR. NRADINT == 3 )THEN ! For grid point interpolations we need to calculate the halo size ! required by each processor ALLOCATE(ZLATX(RADGRID%NGPTOTMX)) ALLOCATE(ZLONX(RADGRID%NGPTOTMX)) DO J=1,RADGRID%NGPTOT ZLATX(J)=RADGRID%GELAT(J)/RPI*2.0_JPRB*90.0 ZLONX(J)=(RADGRID%GELAM(J)-RPI)/RPI*180.0 ENDDO ZMINRADLAT=MINVAL(ZLATX(1:RADGRID%NGPTOT)) ZMAXRADLAT=MAXVAL(ZLATX(1:RADGRID%NGPTOT)) ZMINRADLON=MINVAL(ZLONX(1:RADGRID%NGPTOT)) ZMAXRADLON=MAXVAL(ZLONX(1:RADGRID%NGPTOT)) IF( LLDEBUG )THEN WRITE(NULOUT,'("RADGRID,BEGIN")') IF( MYPROC /= 1 )THEN stop 'Pas pret pour proc > 1' ! CALL MPL_SEND(RADGRID%NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.R') ! CALL MPL_SEND(ZLATX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD.R') ! CALL MPL_SEND(ZLONX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD.R') ENDIF IF( MYPROC == 1 )THEN DO JROC=1,NPROC IF( JROC == MYPROC )THEN DO J=1,RADGRID%NGPTOT WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),MYPROC ENDDO ELSE stop 'Pas pret pour proc > 1' ! CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.M') ! CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD.M') ! CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD.M') DO J=1,IGPTOT WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),JROC ENDDO ENDIF ENDDO ENDIF WRITE(NULOUT,'("RADGRID,END")') ENDIF DEALLOCATE(ZLATX) DEALLOCATE(ZLONX) ALLOCATE(ZLATX(NGPTOTMX)) ALLOCATE(ZLONX(NGPTOTMX)) DO J=1,NGPTOT ZLATX(J)=GELAT(J)/RPI*2.0_JPRB*90.0 ZLONX(J)=(GELAM(J)-RPI)/RPI*180.0 ENDDO ZMINMDLLAT=MINVAL(ZLATX(1:NGPTOT)) ZMAXMDLLAT=MAXVAL(ZLATX(1:NGPTOT)) ZMINMDLLON=MINVAL(ZLONX(1:NGPTOT)) ZMAXMDLLON=MAXVAL(ZLONX(1:NGPTOT)) IF( LLDEBUG )THEN WRITE(NULOUT,'("MODELGRID,BEGIN")') IF( MYPROC /= 1 )THEN stop 'Pas pret pour proc > 1' ! CALL MPL_SEND(NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD') ! CALL MPL_SEND(ZLATX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD') ! CALL MPL_SEND(ZLONX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD') ! CALL MPL_SEND(NGLOBALINDEX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=4,CDSTRING='SUECRAD') ENDIF IF( MYPROC == 1 )THEN DO JROC=1,NPROC IF( JROC == MYPROC )THEN DO J=1,NGPTOT WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),MYPROC,NGLOBALINDEX(J) ENDDO ELSE stop 'Pas pret pour proc > 1' ! CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD') ! CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD') ! CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD') ALLOCATE(IGLOBALINDEX(1:IGPTOT)) ! CALL MPL_RECV(IGLOBALINDEX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=4,CDSTRING='SUECRAD') DO J=1,IGPTOT WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),JROC,IGLOBALINDEX(J) ENDDO DEALLOCATE(IGLOBALINDEX) ENDIF ENDDO ENDIF WRITE(NULOUT,'("MODELGRID,END")') ENDIF DEALLOCATE(ZLATX) DEALLOCATE(ZLONX) IF( LLDEBUG )THEN WRITE(NULOUT,'("ZMINRADLAT=",F10.2)')ZMINRADLAT WRITE(NULOUT,'("ZMINMDLLAT=",F10.2)')ZMINMDLLAT WRITE(NULOUT,'("ZMAXRADLAT=",F10.2)')ZMAXRADLAT WRITE(NULOUT,'("ZMAXMDLLAT=",F10.2)')ZMAXMDLLAT WRITE(NULOUT,'("ZMINRADLON=",F10.2)')ZMINRADLON WRITE(NULOUT,'("ZMINMDLLON=",F10.2)')ZMINMDLLON WRITE(NULOUT,'("ZMAXRADLON=",F10.2)')ZMAXRADLON WRITE(NULOUT,'("ZMAXMDLLON=",F10.2)')ZMAXMDLLON ENDIF ZLAT=NDGLG/180. ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT) ILATS_DIFF_F=FLOOR (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT) IF( ZMINRADLAT < ZMINMDLLAT )THEN NRIWIDES=JP_MIN_HALO+ILATS_DIFF_C ELSE NRIWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) ENDIF ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT) ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT) IF( ZMAXRADLAT < ZMAXMDLLAT )THEN NRIWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) ELSE NRIWIDEN=JP_MIN_HALO+ILATS_DIFF_C ENDIF ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT) ILATS_DIFF_F=FLOOR (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT) IF( ZMINRADLON < ZMINMDLLON )THEN NRIWIDEW=JP_MIN_HALO+ILATS_DIFF_C ELSE NRIWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) ENDIF ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT) ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT) IF( ZMAXRADLON < ZMAXMDLLON )THEN NRIWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) ELSE NRIWIDEE=JP_MIN_HALO+ILATS_DIFF_C ENDIF ZLAT=RADGRID%NDGLG/180. ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT) ILATS_DIFF_F=FLOOR (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT) IF( ZMINMDLLAT < ZMINRADLAT )THEN NROWIDES=JP_MIN_HALO+ILATS_DIFF_C ELSE NROWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) ENDIF ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT) ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT) IF( ZMAXMDLLAT < ZMAXRADLAT )THEN NROWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) ELSE NROWIDEN=JP_MIN_HALO+ILATS_DIFF_C ENDIF ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT) ILATS_DIFF_F=FLOOR (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT) IF( ZMINMDLLON < ZMINRADLON )THEN NROWIDEW=JP_MIN_HALO+ILATS_DIFF_C ELSE NROWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) ENDIF ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT) ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT) IF( ZMAXMDLLON < ZMAXRADLON )THEN NROWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) ELSE NROWIDEE=JP_MIN_HALO+ILATS_DIFF_C ENDIF ENDIF RADGRID%NDGSAH=MAX(RADGRID%NDGSAG,& & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF RADGRID%NDGENH=MIN(RADGRID%NDGENG,& & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAH =",I8)')RADGRID%NDGSAH WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENH =",I8)')RADGRID%NDGENH IF( NRADINT == 2 .OR. NRADINT == 3 )THEN ILBRLATI = MAX(RADGRID%NDGSAG,& & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF IUBRLATI = MIN(RADGRID%NDGENG,& & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF ALLOCATE(RADGRID%RLATI(ILBRLATI:IUBRLATI)) ALLOCATE(RADGRID%RIPI0(ILBRLATI:IUBRLATI)) ALLOCATE(RADGRID%RIPI1(ILBRLATI:IUBRLATI)) ALLOCATE(RADGRID%RIPI2(ILBRLATI:IUBRLATI)) DO JGL= ILBRLATI,IUBRLATI IGLGLO=JGL+RADGRID%NFRSTLOFF IF(IGLGLO >= 0.AND.IGLGLO <= RADGRID%NDGLG) THEN ZD1=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO) ZD2=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+1) ZD3=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+2) ZD4=RADGRID%RLATIG(IGLGLO )-RADGRID%RLATIG(IGLGLO+1) ZD5=RADGRID%RLATIG(IGLGLO )-RADGRID%RLATIG(IGLGLO+2) ZD6=RADGRID%RLATIG(IGLGLO+1)-RADGRID%RLATIG(IGLGLO+2) RADGRID%RIPI0(JGL)=-1.0_JPRB/(ZD1*ZD4*ZD5) RADGRID%RIPI1(JGL)= 1.0_JPRB/(ZD2*ZD4*ZD6) RADGRID%RIPI2(JGL)=-1.0_JPRB/(ZD3*ZD5*ZD6) ENDIF RADGRID%RLATI(JGL)=RADGRID%RLATIG(IGLGLO) ENDDO IF( NPROC > 1 )THEN IRIRPTSUR=NGPTOTG IRISPTSUR=2*NGPTOTG ELSE IRIRPTSUR=0 IRISPTSUR=0 ENDIF ALLOCATE(NRISTA(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES)) ALLOCATE(NRIONL(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES)) ALLOCATE(NRIOFF(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES)) ALLOCATE(NRIEXT(1-NDLON:NDLON+NDLON,1-NRIWIDEN:NDGENL+NRIWIDES)) ALLOCATE(NRICORE(NGPTOT)) ALLOCATE(IRISENDPOS(IRISPTSUR)) ALLOCATE(IRIRECVPOS(IRIRPTSUR)) ALLOCATE(IRISENDPTR(NPROC+1)) ALLOCATE(IRIRECVPTR(NPROC+1)) ALLOCATE(IRICOMM(NPROC)) ALLOCATE(IRIMAP(4,NDGLG)) ! MPL 1.12.08 ! CALL RDCSET('RI',NRIWIDEN,NRIWIDES,NRIWIDEW,NRIWIDEE,& ! & IRIRPTSUR,IRISPTSUR,& ! & NDGLG,NDLON,NDGSAG,NDGENG,IDUM,IDUM,NDGSAL,NDGENL,& ! & NDSUR1,NDLSUR,NDGSUR,NGPTOT,IDUM,& ! & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,& ! & NSTA,NONL,NLOENG,NPTRFRSTLAT,NFRSTLAT,NLSTLAT,& ! & RMU,RSQM2,& ! & NRISTA,NRIONL,NRIOFF,NRIEXT,NRICORE,NARIB1,& ! & NRIPROCS,NRIMPBUFSZ,NRIRPT,NRISPT,& ! & IRISENDPOS,IRIRECVPOS,IRISENDPTR,IRIRECVPTR,IRICOMM,IRIMAP,IRIMAPLEN) CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE') WRITE(NULOUT,'("SUECRAD: NARIB1=",I12)')NARIB1 ALLOCATE(NRISENDPOS(NRISPT)) ALLOCATE(NRIRECVPOS(NRIRPT)) ALLOCATE(NRISENDPTR(NRIPROCS+1)) ALLOCATE(NRIRECVPTR(NRIPROCS+1)) ALLOCATE(NRICOMM(NRIPROCS)) NRISENDPOS(1:NRISPT)=IRISENDPOS(1:NRISPT) NRIRECVPOS(1:NRIRPT)=IRIRECVPOS(1:NRIRPT) NRISENDPTR(1:NRIPROCS+1)=IRISENDPTR(1:NRIPROCS+1) NRIRECVPTR(1:NRIPROCS+1)=IRIRECVPTR(1:NRIPROCS+1) NRICOMM(1:NRIPROCS)=IRICOMM(1:NRIPROCS) DEALLOCATE(IRISENDPOS) DEALLOCATE(IRIRECVPOS) DEALLOCATE(IRISENDPTR) DEALLOCATE(IRIRECVPTR) DEALLOCATE(IRICOMM) DEALLOCATE(IRIMAP) IF( NPROC > 1 )THEN IRORPTSUR=RADGRID%NGPTOTG IROSPTSUR=2*RADGRID%NGPTOTG ELSE IRORPTSUR=0 IROSPTSUR=0 ENDIF ALLOCATE(NROSTA(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES)) ALLOCATE(NROONL(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES)) ALLOCATE(NROOFF(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES)) ALLOCATE(NROEXT(1-RADGRID%NDLON:RADGRID%NDLON+RADGRID%NDLON,& & 1-NROWIDEN:RADGRID%NDGENL+NROWIDES)) ALLOCATE(NROCORE(RADGRID%NGPTOT)) ALLOCATE(IROSENDPOS(IROSPTSUR)) ALLOCATE(IRORECVPOS(IRORPTSUR)) ALLOCATE(IROSENDPTR(NPROC+1)) ALLOCATE(IRORECVPTR(NPROC+1)) ALLOCATE(IROCOMM(NPROC)) ALLOCATE(IROMAP(4,RADGRID%NDGLG)) ! MPL 1.12.08 ! CALL RDCSET('RO',NROWIDEN,NROWIDES,NROWIDEW,NROWIDEE,& ! & IRORPTSUR,IROSPTSUR,& ! & RADGRID%NDGLG,RADGRID%NDLON,RADGRID%NDGSAG,& ! & RADGRID%NDGENG,IDUM,IDUM,RADGRID%NDGSAL,RADGRID%NDGENL,& ! & RADGRID%NDSUR1,RADGRID%NDLSUR,RADGRID%NDGSUR,RADGRID%NGPTOT,IDUM,& ! & RADGRID%NPTRFLOFF,RADGRID%NFRSTLOFF,RADGRID%MYFRSTACTLAT,RADGRID%MYLSTACTLAT,& ! & RADGRID%NSTA,RADGRID%NONL,RADGRID%NLOENG,RADGRID%NPTRFRSTLAT,& ! & RADGRID%NFRSTLAT,RADGRID%NLSTLAT,& ! & RADGRID%RMU,RADGRID%RSQM2,& ! & NROSTA,NROONL,NROOFF,NROEXT,NROCORE,NAROB1,& ! & NROPROCS,NROMPBUFSZ,NRORPT,NROSPT,& ! & IROSENDPOS,IRORECVPOS,IROSENDPTR,IRORECVPTR,IROCOMM,IROMAP,IROMAPLEN) CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE') WRITE(NULOUT,'("SUECRAD: NAROB1=",I12)')NAROB1 ALLOCATE(NROSENDPOS(NROSPT)) ALLOCATE(NRORECVPOS(NRORPT)) ALLOCATE(NROSENDPTR(NROPROCS+1)) ALLOCATE(NRORECVPTR(NROPROCS+1)) ALLOCATE(NROCOMM(NROPROCS)) NROSENDPOS(1:NROSPT)=IROSENDPOS(1:NROSPT) NRORECVPOS(1:NRORPT)=IRORECVPOS(1:NRORPT) NROSENDPTR(1:NROPROCS+1)=IROSENDPTR(1:NROPROCS+1) NRORECVPTR(1:NROPROCS+1)=IRORECVPTR(1:NROPROCS+1) NROCOMM(1:NROPROCS)=IROCOMM(1:NROPROCS) DEALLOCATE(IROSENDPOS) DEALLOCATE(IRORECVPOS) DEALLOCATE(IROSENDPTR) DEALLOCATE(IRORECVPTR) DEALLOCATE(IROCOMM) DEALLOCATE(IROMAP) IF( LLDEBUG )THEN WRITE(NULOUT,'("")') IRIWIDEMAXN=0 IRIWIDEMAXS=0 IRIWIDEMAXW=0 IRIWIDEMAXE=0 IROWIDEMAXN=0 IROWIDEMAXS=0 IROWIDEMAXW=0 IROWIDEMAXE=0 IARIB1MAX=0 IAROB1MAX=0 IWIDE(1)=NRIWIDEN IWIDE(2)=NRIWIDES IWIDE(3)=NRIWIDEW IWIDE(4)=NRIWIDEE IWIDE(5)=NROWIDEN IWIDE(6)=NROWIDES IWIDE(7)=NROWIDEW IWIDE(8)=NROWIDEE IWIDE(9)=NARIB1 IWIDE(10)=NAROB1 IF( MYPROC /= 1 )THEN stop 'Pas pret pour proc > 1' ! CALL MPL_SEND(IWIDE(1:10),KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.W') ENDIF IF( MYPROC == 1 )THEN DO JROC=1,NPROC IF( JROC /= MYPROC )THEN stop 'Pas pret pour proc > 1' ! CALL MPL_RECV(IWIDE(1:10),KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.W') ENDIF WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEN=",I3,2X,"NROWIDEN=",I3 )')& & JROC,IWIDE(1),IWIDE(5) WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDES=",I3,2X,"NROWIDES=",I3 )')& & JROC,IWIDE(2),IWIDE(6) WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEW=",I3,2X,"NROWIDEW=",I3 )')& & JROC,IWIDE(3),IWIDE(7) WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEE=",I3,2X,"NROWIDEE=",I3 )')& & JROC,IWIDE(4),IWIDE(8) WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NARIB1=",I10,2X,"NAROB1=",I10 )')& & JROC,IWIDE(9),IWIDE(10) WRITE(NULOUT,'("")') IF( IWIDE(1) > IRIWIDEMAXN ) IRIWIDEMAXN=IWIDE(1) IF( IWIDE(2) > IRIWIDEMAXS ) IRIWIDEMAXS=IWIDE(2) IF( IWIDE(3) > IRIWIDEMAXW ) IRIWIDEMAXW=IWIDE(3) IF( IWIDE(4) > IRIWIDEMAXE ) IRIWIDEMAXE=IWIDE(4) IF( IWIDE(5) > IROWIDEMAXN ) IROWIDEMAXN=IWIDE(5) IF( IWIDE(6) > IROWIDEMAXS ) IROWIDEMAXS=IWIDE(6) IF( IWIDE(7) > IROWIDEMAXW ) IROWIDEMAXW=IWIDE(7) IF( IWIDE(8) > IROWIDEMAXE ) IROWIDEMAXE=IWIDE(8) IF( IWIDE(9) > IARIB1MAX ) IARIB1MAX =IWIDE(9) IF( IWIDE(10) > IAROB1MAX ) IAROB1MAX =IWIDE(10) ENDDO WRITE(NULOUT,'("")') WRITE(NULOUT,'("SUECRAD: NRIWIDEN(MAX) =",I8)')IRIWIDEMAXN WRITE(NULOUT,'("SUECRAD: NRIWIDES(MAX) =",I8)')IRIWIDEMAXS WRITE(NULOUT,'("SUECRAD: NRIWIDEW(MAX) =",I8)')IRIWIDEMAXW WRITE(NULOUT,'("SUECRAD: NRIWIDEE(MAX) =",I8)')IRIWIDEMAXE WRITE(NULOUT,'("SUECRAD: NROWIDEN(MAX) =",I8)')IROWIDEMAXN WRITE(NULOUT,'("SUECRAD: NROWIDES(MAX) =",I8)')IROWIDEMAXS WRITE(NULOUT,'("SUECRAD: NROWIDEW(MAX) =",I8)')IROWIDEMAXW WRITE(NULOUT,'("SUECRAD: NROWIDEE(MAX) =",I8)')IROWIDEMAXE WRITE(NULOUT,'("SUECRAD: NARIB1(MAX) =",I10)')IARIB1MAX WRITE(NULOUT,'("SUECRAD: NAROB1(MAX) =",I10)')IAROB1MAX WRITE(NULOUT,'("")') ENDIF CALL FLUSH(NULOUT) ENDIF ENDIF ! CALL GSTATS(1818,1) MPL 2.12.08 ELSE WRITE(NULOUT,'("SUECRAD: INVALID VALUE FOR NRADINT=",I6)')NRADINT CALL ABOR1('SUECRAD: NRADINT INVALID') ENDIF ENDIF ! END OF LERADI BLOCK ! ---------------------------------------------------------------- !* 4. INITIALIZE RADIATION COEFFICIENTS. ! ---------------------------------- RCDAY = RDAY * RG / RCPD DIFF = 1.66_JPRB R10E = 0.4342945_JPRB ! CALL GSTATS(1818,0) MPL 2.12.08 CALL SURDI IF (NINHOM == 0) THEN RLWINHF=1._JPRB RSWINHF=1._JPRB ENDIF ! ---------------------------------------------------------------- !* 5. INITIALIZE RADIATION ABSORPTION COEFFICIENTS ! -------------------------------------------- !* 5.1. Initialization routine for RRTM ! ------------------------------- CALL SURRTAB CALL SURRTPK CALL SURRTRF CALL SURRTFTR IF (LRRTM) THEN IF (KLEV > JPLAY) THEN WRITE(UNIT=KULOUT,& & FMT='('' RRTM MAXIMUM NUMBER OF LAYERS IS REACHED'',& & '' CALL ABORT'')') CALL ABOR1(' ABOR1 CALLED SUECRAD') ENDIF ! Read the absorption coefficient data and reduce from 256 to 140 g-points CALL RRTM_INIT_140GP INBLW=16 ELSE INBLW=6 ENDIF CALL SULWN CALL SUSWN (NTSW, NSW) CALL SUCLOPN (NTSW, NSW, KLEV) !-- routines specific to SRTM IF (LSRTM) THEN NTSW=14 ISW =14 CALL SRTM_INIT CALL SUSRTAER CALL SUSRTCOP WRITE(UNIT=KULOUT,FMT='(''SRTM Configuration'',L8,3I4)')LSRTM,NTSW,ISW,JPGPT ELSE IF (.NOT.LONEWSW .OR. ((NSW /= 2).AND.(NSW /= 4).AND.(NSW /= 6)) ) THEN WRITE(UNIT=KULOUT,FMT='(''Wrong SW Configuration'',L8,I3)')LONEWSW,NSW ENDIF CALL SUSWN (NTSW,NSW) CALL SUAERSN (NTSW,NSW) ENDIF WRITE(UNIT=KULOUT,FMT='('' NLW,NTSW,NSW SET EQUAL TO:'',3I3)') INBLW,NTSW,NSW !-- routine specific to the UV processor IF (LUVPROC) THEN NUVTIM = NUVTIM * 86400 CALL SU_UVRAD ( NUV ) ENDIF ! ---------------------------------------------------------------- !* 6. INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION ! ------------------------------------------------------ !- LW optical properties CALL SUAERL !- SW optical properties moved above !CALL SUAERSN (NTSW,NSW) !- horizontal distribution CALL SUAERH !- vertical distribution CALL SUAERV ( KLEV , PETAH,& & CVDAES , CVDAEL , CVDAEU , CVDAED,& & RCTRBGA, RCVOBGA, RCSTBGA, RCAEOPS, RCAEOPL, RCAEOPU,& & RCAEOPD, RCTRPT , RCAEADK, RCAEADM, RCAEROS & & ) !-- Overlap function (only used if NOVLP=4) ! Appel supprime par MPL (30042010) car NOVLP=4 pas utilise ! sinon il faudrait calculer le geopotentiel STZ !CALL SUOVLP ( KLEV ) !-- parameters for prognostic aerosols CALL SU_AERW ! ---------------------------------------------------------------- !* 7. INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS ! ------------------------------------------------------- IF (LEPHYS .AND. NMODE > 1) THEN CALL SUSAT ENDIF !CALL GSTATS(1818,1) MPL 2.12.08 ! ---------------------------------------------------------------- !* 8. INITIALIZE CLIMATOLOGICAL OZONE DISTRIBUTION ! -------------------------------------------- ! (not done here!!! called from APLPAR as it depends ! on model pressure levels!) ! ---------------------------------------------------------------- !* 9. SET UP MODEL CONFIGURATION FOR TIME-SPACE INTERPOLATION ! ------------------------------------------------------- ZTSTEP=MAX(TSTEP,1.0_JPRB) ZSTPHR=3600._JPRB/ZTSTEP IRADFR=NRADFR IF(NRADFR < 0) THEN NRADFR=-NRADFR*ZSTPHR+0.5_JPRB ENDIF NRADPFR=NRADPFR*NRADFR IF (MOD(NRADPLA,2) == 0.AND. NRADPLA /= 0) THEN NRADPLA=NRADPLA+1 ENDIF IF(NRADUV < 0) THEN NRADUV=-NRADUV*ZSTPHR+0.5_JPRB ENDIF IST1HR=ZSTPHR+0.05_JPRB ISTNHR= NLNGR1H *ZSTPHR+0.05_JPRB IF (MOD(3600._JPRB,ZTSTEP) > 0.1_JPRB) THEN 801 CONTINUE IST1HR=IST1HR+1 IF (MOD(ISTNHR,IST1HR) /= 0) GO TO 801 ENDIF IF (NRADFR == 1) THEN NRADSFR=NRADFR ELSE NRADSFR=IST1HR ENDIF NRADNFR=NRADFR IF(LRAYFM) THEN NRPROMA=NDLON+6+(1-MOD(NDLON,2)) ENDIF ! ---------------------------------------------------------------- !* 10. ALLOCATE WORK ARRAYS ! -------------------- IU = NULOUT LLP = NPRINTLEV >= 1.OR. LALLOPR IF (LEPHYS) THEN ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS)) IF(LLP)WRITE(IU,9) 'EMTD ',SIZE(EMTD ),SHAPE(EMTD ) ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS)) IF(LLP)WRITE(IU,9) 'TRSW ',SIZE(TRSW ),SHAPE(TRSW ) ALLOCATE(EMTC(NPROMA,NFLEVG+1,NGPBLKS)) IF(LLP)WRITE(IU,9) 'EMTC ',SIZE(EMTC ),SHAPE(EMTC ) ALLOCATE(TRSC(NPROMA,NFLEVG+1,NGPBLKS)) IF(LLP)WRITE(IU,9) 'TRSC ',SIZE(TRSC ),SHAPE(TRSC ) ALLOCATE(SRSWD(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'SRSWD ',SIZE(SRSWD ),SHAPE(SRSWD ) ALLOCATE(SRLWD(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'SRLWD ',SIZE(SRLWD ),SHAPE(SRLWD ) ALLOCATE(SRSWDCS(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'SRSWDCS ',SIZE(SRSWDCS ),SHAPE(SRSWDCS ) ALLOCATE(SRLWDCS(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'SRLWDCS ',SIZE(SRLWDCS ),SHAPE(SRLWDCS ) ALLOCATE(SRSWDV(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'SRSWDV ',SIZE(SRSWDV ),SHAPE(SRSWDV ) ALLOCATE(SRSWDUV(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'SRSWDUV ',SIZE(SRSWDUV ),SHAPE(SRSWDUV ) ALLOCATE(EDRO(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'EDRO ',SIZE(EDRO ),SHAPE(EDRO ) ALLOCATE(SRSWPAR(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'SRSWPAR ',SIZE(SRSWPAR ),SHAPE(SRSWPAR ) ALLOCATE(SRSWUVB(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'SRSWUVB ',SIZE(SRSWUVB ),SHAPE(SRSWUVB ) ELSEIF(LMPHYS .AND. (LRAYFM.OR.LRAYFM15)) THEN ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS)) IF(LLP)WRITE(IU,9) 'EMTD ',SIZE(EMTD ),SHAPE(EMTD ) ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS)) IF(LLP)WRITE(IU,9) 'TRSW ',SIZE(TRSW ),SHAPE(TRSW ) ALLOCATE(EMTU(NPROMA,NFLEVG+1,NGPBLKS)) IF(LLP)WRITE(IU,9) 'EMTC ',SIZE(EMTU ),SHAPE(EMTU ) ALLOCATE(RMOON(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'RMOON ',SIZE(RMOON ),SHAPE(RMOON ) ENDIF ALLOCATE(SRSWPARC(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'SRSWPARC ',SIZE(SRSWPARC ),SHAPE(SRSWPARC ) ALLOCATE(SRSWTINC(NPROMA,NGPBLKS)) IF(LLP)WRITE(IU,9) 'SRSWTINC ',SIZE(SRSWTINC ),SHAPE(SRSWTINC ) 9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) ! ---------------------------------------------------------------- !* 10. PRINT FINAL VALUES. ! ------------------- IF (LOUTPUT) THEN WRITE(UNIT=KULOUT,FMT='('' COMMON YOERAD '')') WRITE(UNIT=KULOUT,FMT='('' LERADI = '',L5 & & ,'' LERAD1H = '',L5,'' LECO2VAR= '',L5,'' LHGHG = '',L5 & & ,'' NLNGR1H = '',I2,'' NRADSFR = '',I2)')& & LERADI,LERAD1H,LECO2VAR,LHGHG,NLNGR1H,NRADSFR WRITE(UNIT=KULOUT,FMT='('' LEPO3RA = '',L5,'' YO3%LGP = '',L5 )') LEPO3RA,YO3%LGP WRITE(UNIT=KULOUT,FMT='('' NRADFR = '',I2 & & ,'' NRADPFR = '',I3 & & ,'' NRADPLA = '',I2 & & ,'' NRINT = '',I1 & & ,'' NRPROMA = '',I5 & & )')& & NRADFR,NRADPFR,NRADPLA,NRINT, NRPROMA WRITE(UNIT=KULOUT,FMT='('' LERADHS= '',L5 & & ,'' LRRTM = '',L5 & & ,'' LSRTM = '',L5 & & ,'' NMODE = '',I1 & & ,'' NOZOCL= '',I1 & & ,'' NAER = '',I1 & & ,'' NHINCSOL='',I2 & & )')& & LERADHS,LRRTM,LSRTM,NMODE,NOZOCL,NAER,NHINCSOL IF (.NOT.LHGHG .AND. .NOT.LECO2VAR) WRITE(UNIT=KULOUT,FMT='('' RCCO2= '',E10.3 & &,'' RCCH4= '',E10.3,'' RCN2O= '',E10.3,'' RCCFC11= '',E10.3,'' RCFC12= '',E10.3 & &)')& & RCCO2,RCCH4,RCN2O,RCCFC11,RCCFC12 WRITE(UNIT=KULOUT,FMT='('' NINHOM = '',I1 & & ,'' NLAYINH='',I1 & & ,'' RLWINHF='',F4.2 & & ,'' RSWINHF='',F4.2 & & )')& & NINHOM,NLAYINH,RLWINHF,RSWINHF IF (NPERTAER /= 0 .OR. NPERTOZ /= 0) THEN WRITE(UNIT=KULOUT,FMT='('' NPERTAER= '',I2 & & ,'' LNOTROAER='',L5 & & ,'' NPERTOZ = '',I1 & & ,'' RPERTOZ = '',F5.0 & & )')& & NPERTAER,LNOTROAER,NPERTOZ,RPERTOZ ENDIF WRITE(UNIT=KULOUT,FMT='('' NRADINT = '',I2)')NRADINT WRITE(UNIT=KULOUT,FMT='('' NRADRES = '',I4)')NRADRES WRITE(UNIT=KULOUT,FMT='('' LRADONDEM = '',L5)')LRADONDEM IF( NRADINT > 0 )THEN IDIR=LEN_TRIM(CRTABLEDIR) IFIL=LEN_TRIM(CRTABLEFIL) WRITE(UNIT=KULOUT,FMT='('' CRTABLEDIR = '',A,'' CRTABLEFIL = '',A)')& & CRTABLEDIR(1:IDIR),CRTABLEFIL(1:IFIL) ENDIF WRITE(UNIT=KULOUT,FMT='('' LCCNL = '',L5 & & ,'' LCCNO = '',L5 & & ,'' RCCNLND= '',F5.0 & & ,'' RCCNSEA= '',F5.0 & & ,'' LE4ALB = '',L5 & &)')& & LCCNL,LCCNO,RCCNLND,RCCNSEA,LE4ALB IF (LHVOLCA) THEN WRITE(UNIT=KULOUT,FMT='('' HISTORY OF VOLCANIC AEROSOLS= '',L5)')LHVOLCA ENDIF WRITE(UNIT=KULOUT,FMT='('' LONEWSW= '',L5 & & ,'' NRADIP = '',I1 & & ,'' NRADLP = '',I1 & & ,'' NICEOPT= '',I1 & & ,'' NLIQOPT= '',I1 & & ,'' LDIFFC = '',L5 & & )')& & LONEWSW,NRADIP,NRADLP,NICEOPT,NLIQOPT,LDIFFC WRITE(UNIT=KULOUT,FMT='('' WARNING! CLOUD OVERLAP ASSUMPT. IS''& & ,'' NOVLP = '',I2 & & )')& & NOVLP IF (LUVPROC) THEN IDAYUV=NUVTIM/86400 WRITE(UNIT=KULOUT,FMT='('' LUVPROC = '',L5 & & ,'' LUVTDEP= '',L5 & & ,'' NRADUV = '',I2 & & ,'' NUV = '',I2 & & ,'' NDAYUV = '',I5 & & ,'' RMUZUV = '',E9.3 & & )')& & LUVPROC,LUVTDEP,NRADUV,NUV,IDAYUV,RMUZUV WRITE(UNIT=KULOUT,FMT='('' RUVLAM = '',24F6.1)') (RUVLAM(JUV),JUV=1,NUV) WRITE(UNIT=KULOUT,FMT='('' JUVLAM = '',24(3X,I1,2X))') (JUVLAM(JUV),JUV=1,NUV) ENDIF WRITE(UNIT=KULOUT,FMT='('' NMCICA= '',I2 & & )')& & NMCICA ENDIF ! ------------------------------------------------------------------ IF (LHOOK) CALL DR_HOOK('SUECRAD',1,ZHOOK_HANDLE) END SUBROUTINE SUECRAD