* PACKAGE AADMIN !! admin: 1D main routine * * [HIS] 96/06/17(numaguti) AGCM5.4f * 98/03/17(numaguti) AGCM5.5b * 99/02/16(takata) modifies TIMSTP for GSWP * 00/09/07(takata&motoya) corrected parameter for SHTINS * 00/10/02(takata) AGCM5.5p *********************************************************************** SUBROUTINE ATMSTP !! AGCM step M ( TIME , I TEND ) * * [PARAM] #include "zcdim.F" /* # of grid point & wave */ #include "zpdim.F" /* physics etc. */ #include "zldim.F" /* # of land grid point */ #include "zhdim.F" /* # of char. in string */ #include "zccom.F" /* stand. physical const. */ #include "zcord.F" /* coordinate */ * * [MODIFY] REAL * 8 TIME !! time REAL * 8 TEND !! end time * [INPUT] LOGICAL OEND !! end integration flag * * [INTERNAL SAVE] REAL*8 GRIDX ( IJDIM ) !! surface condition INTEGER ISTEP !! serial No. of step INTEGER IFPAR, JFPAR, ISO * : time etc. * REAL*8 DELT !! time step delta(t) REAL * 8 TSTART !! start time * LOGICAL OPCALC !! this rank run or not LOGICAL OMEMRY LOGICAL OINIT * SAVE GRIDX SAVE ISTEP, DELT SAVE TSTART SAVE IFPAR , JFPAR SAVE OPCALC, OMEMRY * * [INTERNAL WORK] REAL*8 GDU ( IJDIM, KMAX ) !! westerly REAL*8 GDV ( IJDIM, KMAX ) !! southern wind REAL*8 RUNOFF ( IJDIM, NTR ) !! precip. (cumulus) REAL*8 ISORUNOFF ( IJDIM, ISOMAX ) !! precip. (cumulus) * * for reduced memory * REAL*8 RUNOFFS( IJSDIM, NTR ) !! precip. (cumulus) * CHARACTER HTIME*20 REAL * 8 TIMEZ REAL*8 TIM( 2 ) INTEGER ISET INTEGER IJS, LT, IJ INTEGER ILSFC(IJDIM) * DATA ISTEP / 0 / * CHARACTER HCLAS*3 DATA HCLAS / 'ATM' / CHARACTER HITEM*(NCC) CHARACTER HTITL*(NCC*2) * CALL MRYGET( OMEMRY ) * CALL TMSTPG !! control time M ( DELT , I TIME , TEND , GDU , GDV ) * IF( .NOT. OPCALC ) THEN 1001 CONTINUE IF ( TIME .LT. TEND ) THEN ISTEP = ISTEP + 1 CALL CSS2CC ( HTIME, TIME ) WRITE (JFPAR,*) ' *** ATMOS STEP TIME=', HTIME CALL SETTIM ( TIME ) TIMEZ = ANINT( TIME + DELT ) TIME = TIMEZ CALL SETTIM( TIME ) GOTO 1001 ENDIF RETURN ENDIF * 1000 CONTINUE IF ( TIME .LT. TEND ) THEN * ISTEP = ISTEP + 1 * CALL CSS2CC ( HTIME, TIME ) WRITE (JFPAR,*) ' *** ATMOS STEP TIME=', HTIME CALL SETDTL ( TEND, 'ADD' ) CALL SETTIM ( TIME ) CALL HISTRT ( 1 ) * #ifdef OPT_MPE *ccc CALL MPE_Log_event(600, 0, 'start ATMOS) #endif * TIMEZ = ANINT( TIME + DELT ) * CALL SETDAT O ( RUNOFF(1,1) , ISORUNOFF , I GRIDX , TIME , DELT ) * CALL CLCSTR('SURF') * DO ISO=1,ISOMAX !! weighting for coupler input. c CALL MMLT(ISORUNOFF(1,ISO),RUNOFF,ISORUNOFF(1,ISO),IJDIM) CALL COPY (RUNOFF(1,ISO+2),ISORUNOFF(1,ISO),IJDIM) ENDDO * #ifdef OPT_MPE CALL MPE_Log_event(614, 0, 'start SURFCE') #endif * IF( OMEMRY ) THEN !! memory save DO 2000 IJS = 1, IJDIM, IJSDIM CALL PIOSEL( IJS, IJSDIM ) !! set output data handling area CALL MCUT( RUNOFFS, RUNOFF, IJS, IJSDIM, IJDIM, NTR ) CALL SURFCE I ( RUNOFFS, I TIME , DELT , IJS ) * 2000 CONTINUE CALL PIOSEL( 1, IJDIM ) !! reset output data handling area ELSE IJS = 1 CALL SURFCE I ( RUNOFF , I TIME , DELT , IJS ) ENDIF #ifdef OPT_MPE CALL MPE_Log_event(615, 0, 'end SURFCE') #endif CALL CLCEND('SURF') * c CALL FHSTIN c I ( RUNOFF ) * TIME = TIMEZ CALL SETTIM ( TIME ) CALL HISTOU( .FALSE. ) !! output data * GOTO 1000 ENDIF * RETURN *====================================================================== * Initialize *====================================================================== ENTRY ATMINI !! AGCM initialize O ( TIME , TEND ) * * << SETPUP : initial setting >> * CALL REWNML ( IFPAR , JFPAR ) CALL GETOPCALC ( OPCALC ) IF( .NOT. OPCALC ) THEN GOTO 900 ENDIF WRITE ( JFPAR,* ) ' @@@ AADMN: AGCM5.6 SFC OFFLINE 00/10/02 ' $ //' iso-MAT 05/10/27 ' * CALL ASETUP !! initial setup of atmos. O ( TSTART, TEND ) c CALL RDSTRT !! read initial data c O ( ISOVAP, c O OINIT , c M TSTART ) * CALL TIMADJ !! adjust time for experiment M ( TSTART, TEND ) TIME = TSTART TIM( 1 ) = TIME TIM( 2 ) = TEND * ISTEP = 0 * CALL RDDAT O ( GRIDX , ISET , I TIME , 'GRIDX', 'ASFC' , .FALSE. ) * 900 CALL SNDR8_COMM( TIM , 2 , 2 ) IF( .NOT. OPCALC ) THEN TIME = TIM( 1 ) TEND = TIM( 2 ) ENDIF CALL SNDIN_COMM( ISTEP , 1 , 2 ) * RETURN *===================================================================== * Finalize *===================================================================== ENTRY ATMRST I ( TIME , OEND ) * CALL GETOPCALC ( OPCALC ) IF( .NOT. OPCALC ) THEN RETURN ENDIF * CALL HISTOU ( OEND ) * c CALL WRGDST c I ( ISOVAP, c I TIME, TSTART, OEND, 'GA' ) * RETURN END *********************************************************************** SUBROUTINE SETDAT O ( RUNOFF , ISORUNOFF , I GRIDX , TIME , DELT ) * * [PARAM] #include "zcdim.F" /* No. of grid point */ #include "zpdim.F" /* physics etc. */ #include "zldim.F" /* # of land grid point */ #include "zccom.F" /* stand. physical const. */ #include "zcord.F" /* coordinate */ * * [OUTPUT] * REAL*8 RUNOFF ( IJDIM ) !! precip. (convective) REAL*8 ISORUNOFF ( IJDIM, ISOMAX ) !! precip. (convective) * * [INPUT] REAL*8 GRIDX ( IJDIM ) !! surface condition REAL*8 TIME !! time REAL*8 DELT !! time step delta(t) * INTEGER IJ, IFPAR, JFPAR, ISET, ISO, IFG INTEGER NPROCS, MYRANK, ISTA, IEND * * [INTERNAL PARM] NAMELIST /NMSETD/ ZREF, PARRAT, TWCRIT, TDURAD, UTDRAD REAL*8 ZREF !" reference height REAL*8 PARRAT !" ratio of PAR REAL*8 TWCRIT !" critical Tw for snowfall REAL*8 TDURAD !" radiation time duration CHARACTER UTDRAD*4 !" unit for TDURAD REAL*8 VEGH ( IDXMIN:IDXMAX ) !! vegetation height CHARACTER HCLAS*3 LOGICAL OFIRST DATA ZREF / 10.D0 / DATA PARRAT / 0.3D0 / DATA TWCRIT / 273.15D0 / DATA TDURAD / 30.D0 / DATA UTDRAD / 'MIN' / DATA VEGH / IDXNUM*1.D0 / DATA OFIRST / .TRUE. / DATA HCLAS / 'ATM' / * * [EXTERNAL FUNC] LOGICAL OINTVL * * [INTERNAL FUNC] #include "zqsat.F" /* saturate q */ * IF ( OFIRST ) THEN CALL GETMPI O ( NPROCS, MYRANK, ISTA, IEND, IFPAR, JFPAR, I HCLAS ) WRITE ( JFPAR,* ) ' @@@ SETDAT: 0 DIM SET DATA 98/03/30' OFIRST = .FALSE. c CALL PGPGET( VEGH , 'VEGH', 1 ) DO 180 IFG = 1, 2 c CALL GRWNML(IFPAR,JFPAR,IFG) READ ( IFPAR, NMSETD, END=190 ) 190 WRITE ( JFPAR, NMSETD ) 180 CONTINUE * TPRVRD = TIME TORGRD = TIME * CALL CXX2SS( TDRADS, TDURAD, UTDRAD, 0.D0 ) ENDIF * CALL RDDAT O ( RUNOFF , ISET , I TIME , 'RUNOFF' , 'ASFC' , .TRUE. ) * for Iso-MAT CALL RDDAT O ( ISORUNOFF , ISET , I TIME , 'IRUNOFF' , 'ASFI' , .TRUE. ) * c ORDRAD = OINTVL !! time step passed ? c I ( TIME, TPRVRD , TORGRD, TDURAD, UTDRAD ) c CALL HISTIN I ( RUNOFF, 'RUNOFF','total runoff', 'kg/m**2/s','ASFC', HCLAS) CALL HISTIN I ( ISORUNOFF, 'IRUNOFF','total runoff iso.', $ 'kg/m**2/s*SMOW','ASFI', HCLAS) * RETURN END *********************************************************************** SUBROUTINE FHSTIN !! register history output I ( RUNOFF ) * * [PARAM] #include "zhdim.F" #include "zcdim.F" #include "zpdim.F" /* physics etc. */ #include "zccom.F" /* stand. physical const. */ * * [INPUT] * REAL*8 RUNOFF ( IJDIM ) !! precip. (cumulus) CHARACTER HCLAS*3 DATA HCLAS / 'ATM' / CHARACTER HITEM *(NCC) CHARACTER HTITL *(NCC*2) INTEGER LT * CALL HISTIF I ( RUNOFF,'RUNOFF' ,'runoff ','W/m**2','ASFC', I HCLAS, EL ) * RETURN END *********************************************************************** SUBROUTINE RADDER O ( RADN , I SWDOWN, ZLWDN , CLOUD , COSZ ) C====================================================================== C...MODIFIED TO 2-D OFFLINE VERSION ON OCT 18 94 BY N.SATO C====================================================================== C C CALCULATION OF SOLAR ZENITH ANGLE AND SHORTWAVE RADIATION FLUXES C FROM DATE/TIME, CLOUDINESS AND SURFACE METEOROLOGICAL CONDITIONS. C---------------------------------------------------------------------- C #include "zcdim.F" /* # of grid point & wave */ #include "zpdim.F" /* physics etc. */ #include "zldim.F" /* land */ REAL*8 RADN ( IJDIM, NRDIR, NRBND ) REAL*8 SWDOWN ( IJDIM ) REAL*8 ZLWDN ( IJDIM ) REAL*8 CLOUD ( IJDIM ) REAL*8 COSZ ( IJDIM ) REAL*8 VNRAT, DIFRAT INTEGER NPROCS, MYRANK, ISTA, IEND INTEGER IFPAR, JFPAR INTEGER IJ LOGICAL OFIRST DATA OFIRST / .TRUE. / C IF( OFIRST ) THEN OFIRST = .FALSE. CALL GETMPI O ( NPROCS, MYRANK, ISTA, IEND, IFPAR, JFPAR, I 'ATM' ) ENDIF DO 100 IJ=ISTA, IEND C---------------------------------------------------------------------- C C DOWNWELLING SHORTWAVE RADIATION COMPONENTS : GOUDRIAAN (1977) C C---------------------------------------------------------------------- IF ( COSZ(IJ).LT.0 ) SWDOWN(IJ)=0.D0 COSZ(IJ) = MAX (0.01745D0,COSZ(IJ)) DIFRAT = 0.0604D0 / MAX ( 0.01D0 , COSZ(IJ)-0.0223D0 ) + 0.0683D0 DIFRAT = MAX( DIFRAT , 0.D0 ) DIFRAT = MIN( DIFRAT , 1.D0 ) C DIFRAT = DIFRAT + ( 1.D0 - DIFRAT ) * CLOUD (IJ) VNRAT = ( 580.D0 - CLOUD(IJ)*464.D0 ) & / ( ( 580.D0 - CLOUD(IJ)*499.D0 ) & + ( 580.D0 - CLOUD(IJ)*464.D0 ) ) C SWDOWN(IJ) = MAX( SWDOWN(IJ), 0.D0 ) RADN(IJ,1,1) = (1.D0-DIFRAT)*VNRAT*SWDOWN(IJ) RADN(IJ,2,1) = DIFRAT*VNRAT*SWDOWN(IJ) RADN(IJ,1,2) = (1.D0-DIFRAT)*(1.-VNRAT)*SWDOWN(IJ) RADN(IJ,2,2) = DIFRAT*(1.D0-VNRAT)*SWDOWN(IJ) C C---------------------------------------------------------------------- C DOWNWELLING LONGWAVE RADIATION C---------------------------------------------------------------------- C RADN(IJ,1,3) = 0.D0 RADN(IJ,2,3) = ZLWDN(IJ) 100 CONTINUE C RETURN END ********************************************************************** SUBROUTINE TMSTPG !! control time step for gswp O ( DELTX , I TIME , TEND , GDU , GDV ) * * [PARAM] #include "zcdim.F" #include "zccom.F" * * [OUTPUT] REAL*8 DELTX !! time step delta(t) * * [INPUT] REAL * 8 TIME !! time REAL * 8 TEND !! end time REAL*8 GDU ( IJDIM*KMAX ) !! zonal wind REAL*8 GDV ( IJDIM*KMAX ) !! meridional wind * * [INTERNAL SAVE] REAL * 8 DDELT REAL * 8 DDTMIN REAL * 8 DELTSV INTEGER IFPAR, JFPAR LOGICAL OPCALC SAVE DDELT, DDTMIN, DELTSV SAVE OPCALC * * [INTERNAL PARM] REAL*8 DELT !! standard time step CHARACTER TUNIT*4 !! unit REAL*8 DTMIN !! minimum time step REAL*8 SAFER !! safety factor REAL*8 VSMIN !! minimum wind speed sq REAL*8 SECMI INTEGER NSECMI LOGICAL OFIRST LOGICAL OPFIRST NAMELIST /NMDELT/ DELT, TUNIT, DTMIN, SAFER, VSMIN DATA DELT / -30.D0 / DATA TUNIT / 'MIN' / DATA DTMIN / 1.D0 / DATA SAFER / 0.8D0 / DATA VSMIN / 1.D0 / DATA OFIRST / .TRUE. / DATA OPFIRST/ .TRUE. / * IF ( OFIRST ) THEN CALL GETOPCALC( OPCALC ) CALL REWNML ( IFPAR , JFPAR ) WRITE ( JFPAR,* ) ' @@@ ASTEP : TIME STEP ESTIMATION 00/10/02' OFIRST = .FALSE. READ ( IFPAR, NMDELT, END=190 ) 190 WRITE ( JFPAR, NMDELT ) * CALL CXX2SS ( DDELT , DELT , TUNIT, TIME ) CALL CXX2SS ( DDTMIN, DTMIN , TUNIT, TIME ) CALL CSECMI ( NSECMI ) SECMI = DBLE( NSECMI ) DELTSV = -1.D0 * ENDIF * IF( .NOT. OPCALC ) THEN GOTO 990 ENDIF * DELTX = DDELT * 990 CALL SNDR8_COMM( DELTX , 1 , 2 ) * RETURN END ********************************************************************** SUBROUTINE RDSTRT !! read initial data O ( ISOVAP, O OINIT , M TSTART ) * * [PARAM] #include "zcdim.F" /* No. of grid point */ #include "zpdim.F" /* physics etc. */ #include "zldim.F" /* # of land grid point */ #include "zccom.F" /* stand. physical const. */ #include "zcord.F" /* coordinate */ #include "zhdim.F" /* # of char. in string */ * * [OUTPUT] REAL*8 ISOVAP ( IJDIM, ISOMAX ) !! humidity q iso * LOGICAL OINIT !! initialized condition ? * * [MODIFY] REAL * 8 TSTART !! initial time * * [INTERNAL WORK] REAL * 8 TINIT0 !! time of initial data REAL * 8 TINIT1 !! time of initial data REAL * 8 TIME, TIMER, TDURD c REAL * 8 ISOINIT(ISOMAX) INTEGER IFLSTR, IEODIVP, KLEVS, ISO INTEGER IFPAR, JFPAR CHARACTER HDFMT *(NCC) LOGICAL OFIRST DATA OFIRST / .TRUE. / c DATA ISOINIT/ 0.99D0, 0.92D0 / * IF( OFIRST ) THEN CALL REWNML( IFPAR, JFPAR ) OFIRST = .FALSE. ENDIF * CALL OPNINI !! open initial data O ( IFLSTR, TINIT0, TINIT1, HDFMT , I TSTART, 'ATM' ) c 1100 CONTINUE c IF ( TINIT0 .LT. 0 ) THEN GOTO 1100 ENDIF * RETURN END *********************************************************************** SUBROUTINE WRGDST !! write restart data I ( ISOVAP, I TIME , TSTART, OEND , HCLAS ) * * [PARAM] #include "zcdim.F" /* No. of grid point */ #include "zpdim.F" /* physics etc. */ #include "zldim.F" /* # of land grid point */ #include "zccom.F" /* stand. physical const. */ #include "zcord.F" /* coordinate */ #include "zhdim.F" /* # of char. in string */ * * [OUTPUT] REAL*8 ISOVAP ( IJDIM, ISOMAX ) !! humidity q iso * REAL * 8 TIME !! time REAL * 8 TSTART !! start t of calculation LOGICAL OEND !! END of STEP CHARACTER HCLAS *(*) * * [INTERNAL WORK] INTEGER JFLRST !! output file CHARACTER HDFMT *(NCC) !! output format * * [INTERNAL PARAM] REAL * 8 TDUR DATA TDUR / 1.D0 / * CALL OPNRST !! open restart data O ( JFLRST, HDFMT , I TIME , TSTART, OEND , HCLAS ) IF ( JFLRST .LE. 0 ) RETURN * CALL GDWRIT I ( ISOVAP,'IVAP','vapor iso. (for AICM)','ND' , I TIME , TDUR , JFLRST, HDFMT , HCLAS , I IMAX , JMAX , IDIM , JDIM , ISOMAX, 'ASFI' ) * RETURN END