! $Id: suecrad.F90 4251 2022-09-20 00:22:43Z fhourdin $ 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 USE lmdz_clesphys 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 "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