* PACKAGE GTSLP !" ³¤Ì̹¹Àµµ¤°µ *********************************************************************** PROGRAM GTSLP * #ifdef SYS_IBMS INCLUDE (GTSINC) INCLUDE (GZSIZE) #else #include "gtsinc.F" #include "gzsize.F" #endif COMMON /GMWORK/ MWORK REAL MWORK ( IJKDIM ) * CHARACTER HHEADP( NDC )*(NCC) REAL GDATAP( IJKDIM ) CHARACTER HHEADT( NDC )*(NCC) REAL GDATAT( IJKDIM ) CHARACTER HHEADZ( NDC )*(NCC) REAL GDATAZ( IJKDIM ) CHARACTER HITEZ *(NCC) * DATA IFILP / 50 / DATA IFILT / 51 / DATA IFILZ / 52 / DATA JFILE / 60 / * DATA GRAV / 9.8 / * CHARACTER PS *(NFILN) DATA PS / 'Ps' / CHARACTER T *(NFILN) DATA T / 'T' / CHARACTER ZS *(NFILN) DATA ZS / 'ZS' / CHARACTER OUT *(NFILN) DATA OUT / '$GTTMPDIR/gtool.out' / LOGICAL APND DATA APND / .FALSE. / CHARACTER ITEM *(NCC) CHARACTER UNIT *(NCC) CHARACTER TITLE *(NCC*2) CHARACTER DSET *(NCC) CHARACTER EDIT *(NCC) CHARACTER ETTL *(NCC) DATA ITEM / 'SLP' / DATA TITLE / 'Sea Level Pressure' / DATA UNIT, DSET, EDIT, ETTL / 4*' '/ LOGICAL GRESET DATA GRESET / .FALSE. / LOGICAL HELP DATA HELP / .FALSE. / * EXTERNAL CALSLP * NAMELIST /OPTION/ PS , T , ZS , OUT, APND, & ITEM, UNIT, TITLE, DSET, EDIT, ETTL, GRESET, & HELP * CALL OPTARG ( 91, 'OPTION', 'HFILE', NOPT, NFILE ) READ (91,OPTION,IOSTAT=IOS) CLOSE(91) IF ( IOS.NE.0 .OR. HELP ) THEN WRITE(6,OPTION) STOP ENDIF * CALL GTOPEN CALL GTSIZE ( HHEADP, IJKDIM ) CALL GTSIZE ( HHEADT, IJKDIM ) CALL GTSIZE ( HHEADZ, IJKDIM ) CALL GMSIZE ( IJKDIM ) * CALL GURNTF ( PS, OUT , '$GTTMPDIR/gtool.in' ) CALL GURNTF ( T , OUT , '$GTTMPDIR/gtool.in' ) CALL GURNTF ( ZS, OUT , '$GTTMPDIR/gtool.in' ) * CALL GFROPN ( IFILEP, PS ) CALL GFROPN ( IFILET, T ) CALL GFROPN ( IFILEZ, ZS ) CALL GFOOPN ( JFILE , OUT , APND ) * CALL GUNENV( OUT,'.',.FALSE. ) IL=LENC(OUT) WRITE (6,*) 'output='//OUT(1:IL) * CALL GFREAD O ( HHEADZ, GDATAZ, IEODZ , I IFILEZ, 1 ) * IF ( IEODZ .NE. 0 ) THEN CALL MSGDMP('E','GTSLP','ZS FILE NOT FOUND' ) ENDIF * CALL GHCGET( HHEADZ, 'ITEM', HITEZ ) IF ( HITEZ .EQ. 'GPHIS' ) THEN CALL GMFFCT I ( HHEADZ, GDATAZ, 1./GRAV , I ' ' , ' ' ) ENDIF * 1100 CONTINUE CALL GFREAD O ( HHEADP, GDATAP, IEODP , I IFILEP, 1 ) CALL GFREAD O ( HHEADT, GDATAT, IEODT , I IFILET, 1 ) * IF ( MAX(IEODP,IEODT) .EQ.0 ) THEN CALL GMCAL3 I ( CALSLP, M HHEADP, GDATAP, I HHEADT, GDATAT, I HHEADZ, GDATAZ, I EDIT , ETTL ) * IF ( ITEM .NE. ' ' ) THEN CALL GHCSET( HHEADP, 'ITEM', ITEM ) ENDIF IF ( UNIT .NE. ' ' ) THEN CALL GHCSET( HHEADP, 'UNIT', UNIT ) ENDIF IF ( TITLE .NE. ' ' ) THEN CALL GHCSTS( HHEADP, 'TITL', TITLE ) ENDIF IF ( DSET .NE. ' ' ) THEN CALL GHCSET( HHEADP, 'DSET', DSET ) ENDIF IF ( GRESET ) THEN CALL GHRSGP( HHEADP ) ENDIF * CALL GFWRIT I ( HHEADP, GDATAP, I JFILE , 1 , 0 ) * GOTO 1100 ENDIF * STOP END ******************************************************************** SUBROUTINE CALSLP I ( HPS , PS , I HT , T , I HZS , ZS , O HSLP , SLP , D IMAX , JMAX , KMAX , D IMAX2 , JMAX2 , KMAX2, D IMAX3 , JMAX3 , KMAX3 ) * CHARACTER HPS ( * )*(*) REAL PS ( IMAX, JMAX ) CHARACTER HT ( * )*(*) REAL T ( IMAX2, JMAX2, KMAX2 ) CHARACTER HZS ( * )*(*) REAL ZS ( IMAX3, JMAX3 ) CHARACTER HSLP( * )*(*) REAL SLP ( IMAX, JMAX ) * #ifdef SYS_IBMS INCLUDE (GZSIZE) #else #include "gzsize.F" #endif CHARACTER HHS ( NDC )*(NCC) PARAMETER ( KMAXD = 100 ) REAL SIG ( KMAXD ) * IF ( KMAX .GT. KMAXD ) THEN CALL MSGDMP( 'E','SLP','WORK AREA TOO SMALL' ) ENDIF CALL GTSIZE ( HHS , KMAXD ) CALL GUQAXV I ( HT , 3 , 'LOC', O HHS , SIG , IEOD ) * CALL PS2SLP I ( ZS , T , PS , SIG , I IMAX, JMAX, O SLP ) * RETURN END ****************************************************************** SUBROUTINE PS2SLP I ( Z , T , PS , SIG , I IMAX , JMAX , O RSLP ) * --------------------------------------- * CALCULATE SEA LEVEL PRESSURE * * [INPUT] * Z : SURFACE ALTITUDE * T : TEMPERATURE AT SIGMA LEVEL 1 * PS : SURFACE AIR PRESSURE * SIG : SIGMA LEVEL AT EACH LAYER * [OUTPUT] * RSLP : SEA LEVEL PRESSURE * [INTERNAL] * RZ : ALTITUDE AT SIGMA LEVEL 1 * P : AIR PRESSURE AT SIGMA LEVEL 1 * --------------------------------------- REAL Z ( IMAX*JMAX ) REAL T ( IMAX*JMAX ) REAL PS ( IMAX*JMAX ) REAL SIG ( 1 ) REAL RSLP ( IMAX*JMAX ) * DATA RAIR /287.04/ DATA GRAV / 9.8 / * * EVALUATE Z(LEVEL1) USING HYDROSTATIC RELATION * DO 100 IJ = 1, IMAX*JMAX RZ = Z(IJ) - LOG( SIG(1) ) * RAIR * T(IJ) / GRAV * * SEA LEVEL PRESSURE * RSLP(IJ) = PS(IJ) + DELTAP( RZ, T(IJ), PS(IJ)*SIG(1) ) 100 CONTINUE * RETURN END ********************************************************************** REAL FUNCTION DELTAP I ( Z, T, P ) * --------------------------------------------------------------- * ( SEA LEVEL PRESSURE ) - ( SURFACE PRESSURE ) * * THIS METHOD HAVE USED BY THE OBSERVATION SECTION * IN THE JAPANESE METEOROLOGICAL AGENCY. * [INPUT] * Z : ALTITUDE * T : TEMPERATURE * P : AIR PRESSURE * [INTERNAL] * TM : MEAN TEMPERATURE IN THE DESTINATION AIR COLUMN * EM : EFFECT ON AIR MOISTURE * TVM : MEAN VIRTUAL TEMPERATURE IN THE DESTINATION AIR COLUMN * --------------------------------------------------------------- DATA T00 /273.15 / DATA GRAV / 9.8 / DATA RAIR /287.05 / DATA TLAPS / 0.005/ * TM = ( T -T00 ) + TLAPS / 2. * Z EM = EPSM( TM ) TVM = T00 + TM + EM * DELTAP = P * ( EXP( GRAV * Z / ( RAIR * TVM ) ) - 1. ) * RETURN END ********************************************************************* REAL FUNCTION EPSM(TM) * --------------------------------------- * EFFECT ON AIR MOISTURE * (MEAN STATE OF LOWER LAYER IN JAPAN) * --------------------------------------- IF(TM.LT.-30.) THEN EPSM = 0.09 RETURN ELSE IF((-30..LE.TM).AND.(TM.LT.0.)) THEN A = 0.000489 B = 0.0300 C = 0.550 ELSE IF((0..LE.TM).AND.(TM.LT.20.)) THEN A = 0.002850 B = 0.0165 C = 0.550 ELSE IF((20..LE.TM).AND.(TM.LT.33.8)) THEN A =-0.006933 B = 0.4687 C =-4.580 ELSE EPSM = 3.34 RETURN ENDIF * EPSM = ( A * TM + B ) * TM + C * RETURN END