pkg/aim_v23/aim_initialise.F

C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_initialise.F,v 1.6 2004/03/11 14:33:19 jmc Exp $
C $Name:  $

#include "AIM_OPTIONS.h"

      SUBROUTINE AIM_INITIALISE( myThid )
C     *==================================================================*
C     | S/R AIM_INITIALISE
C     *==================================================================*
C     | Initialisation of AIM atmospheric physics package :
C     | 1) call iniphys (=> set parameters to default value)
C     | 2) read AIM parameters 
C     | 3) initialisation of AIM arrays (time-ave)
C     *==================================================================*
      IMPLICIT NONE

C     -------------- Global variables ------------------------------------
#include "SIZE.h" 
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "SURFACE.h"
#include "DYNVARS.h"
#include "AIM_PARAMS.h"
#include "AIM_FFIELDS.h"
c #include "AIM_GRID.h"
#include "AIM_DIAGS.h"

C     == Routine arguments ==
C     myThid -  Number of this instance
      INTEGER myThid

#ifdef ALLOW_AIM
C     == Local variables ==
C     HSG  - Cell face in vertical
C     pGround - Lower boundary pressure
C     i, j, k, bi,bj  - Loop counters
      _RL HSG(0:Nr)
      _RL pGround, tmpPgrnd
      INTEGER i, j, K, bi, bj
      INTEGER Katm

C--  Set default value for AIM interface code (AIM_PARAMS.h):
      aim_useFMsurfBC = .TRUE.
      aim_useMMsurfFc = .FALSE.
      aim_surfPotTemp = .FALSE.
      aim_energPrecip = .FALSE.
      aim_splitSIOsFx = .FALSE.
      aim_clrSkyDiag  = .FALSE.
      aim_MMsufx = '.bin'
      aim_MMsufxLength = 4
      aim_LandFile = ' '
      aim_albFile  = ' '
      aim_vegFile  = ' '
      aim_sstFile  = ' '
      aim_lstFile  = ' '
      aim_oiceFile = ' '
      aim_snowFile = ' '
      aim_swcFile  = ' '
      aim_dragStrato = 0.
      aim_taveFreq = taveFreq
      aim_diagFreq = dumpFreq
      aim_tendFreq = 0.
      
C--  Set default value for atmos. physics parameters:
      pGround = atm_Po
      DO k=1,Nr
       Katm = _KD2KA( k )
       HSG(Katm) = rF(k)/pGround
      ENDDO
       k=Nr+1
       Katm = _KD2KA( k )
       HSG(Katm) = rF(k)/pGround

c     DO bj = myByLo(myThid), myByHi(myThid)
c      DO bi = myBxLo(myThid), myBxHi(myThid)

C--   set default value for all atmos. physics parameter:
        CALL INPHYS( HSG, myThid )

c      ENDDO
c     ENDDO

C--   Read AIM parameters (from file data.aimphys):
      CALL AIM_READPARMS( myThid )

C--   set energy fractions in LW bands as a function of temperature:
C     initialize common block RADFIX (originally called from FORDATE in SPEEDY)
      _BEGIN_MASTER(myThid)  
       CALL RADSET( myThid)
      _END_MASTER ( myThid)  

C--   Set truncSurfP : used to correct for truncation (because of hFacMin)
C      of surface reference pressure Ro_surf that affects Surf.Temp.
      CALL INI_P_GROUND(1, topoZ, truncSurfP, myThid )
      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)
        DO j=1,sNy
         DO i=1,sNx
          tmpPgrnd = MIN(truncSurfP(i,j,bi,bj),atm_Po)
          truncSurfP(i,j,bi,bj)= 
     &     ( Ro_surf(i,j,bi,bj)/tmpPgrnd )**atm_kappa
         ENDDO
        ENDDO
        IF (aim_useMMsurfFc .AND. aim_surfPotTemp) THEN
         DO j=1,sNy
          DO i=1,sNx
           truncSurfP(i,j,bi,bj) =
     &      ( Ro_surf(i,j,bi,bj)/atm_Po )**atm_kappa
          ENDDO
         ENDDO
        ENDIF
       ENDDO
      ENDDO
      
C--   Initialise surface forcing fields (in AIM_FFIELDS.h):
c     DO bj = myByLo(myThid), myByHi(myThid)
c      DO bi = myBxLo(myThid), myBxHi(myThid)
c       DO j=1-Oly,sNy+Oly
c        DO i=1-Olx,sNx+Olx  
c         aim_surfTemp(i,j,bi,bj) = 300.
c         aim_soilWater(i,j,bi,bj) = 0.
c         aim_albedo   (i,j,bi,bj) = 0.
c         aim_landFr   (i,j,bi,bj) = 0.
c        ENDDO
c       ENDDO
c      ENDDO
c     ENDDO

#ifdef ALLOW_AIM_TAVE 
C     Initialise diagnostic counters (these are cleared on model start
C      i.e. not loaded from history file for now ).
      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)
        CALL TIMEAVE_RESET(USTRtave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(VSTRtave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(TSRtave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(OLRtave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(SSRtave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(SLRtave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(SHFtave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(EVAPtave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(PRECNVtave,1, bi, bj, myThid)
        CALL TIMEAVE_RESET(PRECLStave,1, bi, bj, myThid)
        CALL TIMEAVE_RESET(CLOUDCtave,1, bi, bj, myThid)
        CALL TIMEAVE_RESET(CLTOPtave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(CBMFtave,  1, bi, bj, myThid)
        CALL TIMEAVE_RESET(DRAGtave,  1, bi, bj, myThid)
        CALL TIMEAVE_RESET(aimV0tave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(aimT0tave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(aimQ0tave, 1, bi, bj, myThid)
        CALL TIMEAVE_RESET(EnFxPrtave,1, bi, bj, myThid)
        CALL TIMEAVE_RESET(albedotave,1, bi, bj, myThid)
        CALL TIMEAVE_RESET(dTsurftave,1, bi, bj, myThid)
        CALL TIMEAVE_RESET(aimRHtave,Nr, bi, bj, myThid)
        DO k=1,Nr
          aim_timeAve(k,bi,bj) = 0.
        ENDDO
       ENDDO
      ENDDO
#endif /* ALLOW_AIM_TAVE */

#endif /* ALLOW_AIM */

      RETURN
      END
1	jmc	1.7	C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_initialise.F,v 1.6 2004/03/11 14:33:19 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "AIM_OPTIONS.h"
5
6			SUBROUTINE AIM_INITIALISE( myThid )
7			C ==================================================================
8			C \| S/R AIM_INITIALISE
9			C ==================================================================
10			C \| Initialisation of AIM atmospheric physics package :
11			C \| 1) call iniphys (=> set parameters to default value)
12			C \| 2) read AIM parameters
13			C \| 3) initialisation of AIM arrays (time-ave)
14			C ==================================================================
15			IMPLICIT NONE
16
17			C -------------- Global variables ------------------------------------
18			#include "SIZE.h"
19			#include "EEPARAMS.h"
20			#include "PARAMS.h"
21	jmc	1.2	#include "GRID.h"
22			#include "SURFACE.h"
23	jmc	1.1	#include "DYNVARS.h"
24	jmc	1.2	#include "AIM_PARAMS.h"
25			#include "AIM_FFIELDS.h"
26			c #include "AIM_GRID.h"
27	jmc	1.1	#include "AIM_DIAGS.h"
28
29			C == Routine arguments ==
30			C myThid - Number of this instance
31			INTEGER myThid
32
33			#ifdef ALLOW_AIM
34			C == Local variables ==
35			C HSG - Cell face in vertical
36			C pGround - Lower boundary pressure
37	jmc	1.2	C i, j, k, bi,bj - Loop counters
38	jmc	1.1	_RL HSG(0:Nr)
39	jmc	1.2	_RL pGround, tmpPgrnd
40			INTEGER i, j, K, bi, bj
41	jmc	1.1	INTEGER Katm
42
43	jmc	1.2	C-- Set default value for AIM interface code (AIM_PARAMS.h):
44			aim_useFMsurfBC = .TRUE.
45			aim_useMMsurfFc = .FALSE.
46			aim_surfPotTemp = .FALSE.
47	jmc	1.6	aim_energPrecip = .FALSE.
48			aim_splitSIOsFx = .FALSE.
49	jmc	1.7	aim_clrSkyDiag = .FALSE.
50	jmc	1.2	aim_MMsufx = '.bin'
51			aim_MMsufxLength = 4
52			aim_LandFile = ' '
53			aim_albFile = ' '
54			aim_vegFile = ' '
55			aim_sstFile = ' '
56			aim_lstFile = ' '
57			aim_oiceFile = ' '
58			aim_snowFile = ' '
59			aim_swcFile = ' '
60	jmc	1.5	aim_dragStrato = 0.
61	jmc	1.3	aim_taveFreq = taveFreq
62	jmc	1.2	aim_diagFreq = dumpFreq
63			aim_tendFreq = 0.
64
65			C-- Set default value for atmos. physics parameters:
66			pGround = atm_Po
67			DO k=1,Nr
68			Katm = _KD2KA( k )
69			HSG(Katm) = rF(k)/pGround
70	jmc	1.1	ENDDO
71	jmc	1.2	k=Nr+1
72			Katm = _KD2KA( k )
73			HSG(Katm) = rF(k)/pGround
74	jmc	1.1
75			c DO bj = myByLo(myThid), myByHi(myThid)
76			c DO bi = myBxLo(myThid), myBxHi(myThid)
77
78			C-- set default value for all atmos. physics parameter:
79			CALL INPHYS( HSG, myThid )
80
81			c ENDDO
82			c ENDDO
83
84	jmc	1.2	C-- Read AIM parameters (from file data.aimphys):
85			CALL AIM_READPARMS( myThid )
86
87	jmc	1.1	C-- set energy fractions in LW bands as a function of temperature:
88			C initialize common block RADFIX (originally called from FORDATE in SPEEDY)
89			_BEGIN_MASTER(myThid)
90			CALL RADSET( myThid)
91			_END_MASTER ( myThid)
92
93	jmc	1.2	C-- Set truncSurfP : used to correct for truncation (because of hFacMin)
94			C of surface reference pressure Ro_surf that affects Surf.Temp.
95	jmc	1.4	CALL INI_P_GROUND(1, topoZ, truncSurfP, myThid )
96	jmc	1.2	DO bj = myByLo(myThid), myByHi(myThid)
97			DO bi = myBxLo(myThid), myBxHi(myThid)
98			DO j=1,sNy
99			DO i=1,sNx
100			tmpPgrnd = MIN(truncSurfP(i,j,bi,bj),atm_Po)
101			truncSurfP(i,j,bi,bj)=
102			& ( Ro_surf(i,j,bi,bj)/tmpPgrnd )**atm_kappa
103			ENDDO
104			ENDDO
105			IF (aim_useMMsurfFc .AND. aim_surfPotTemp) THEN
106			DO j=1,sNy
107			DO i=1,sNx
108			truncSurfP(i,j,bi,bj) =
109			& ( Ro_surf(i,j,bi,bj)/atm_Po )**atm_kappa
110			ENDDO
111			ENDDO
112			ENDIF
113			ENDDO
114			ENDDO
115
116			C-- Initialise surface forcing fields (in AIM_FFIELDS.h):
117			c DO bj = myByLo(myThid), myByHi(myThid)
118			c DO bi = myBxLo(myThid), myBxHi(myThid)
119			c DO j=1-Oly,sNy+Oly
120			c DO i=1-Olx,sNx+Olx
121			c aim_surfTemp(i,j,bi,bj) = 300.
122			c aim_soilWater(i,j,bi,bj) = 0.
123			c aim_albedo (i,j,bi,bj) = 0.
124			c aim_landFr (i,j,bi,bj) = 0.
125			c ENDDO
126			c ENDDO
127			c ENDDO
128			c ENDDO
129	jmc	1.1
130	jmc	1.3	#ifdef ALLOW_AIM_TAVE
131	jmc	1.1	C Initialise diagnostic counters (these are cleared on model start
132			C i.e. not loaded from history file for now ).
133			DO bj = myByLo(myThid), myByHi(myThid)
134			DO bi = myBxLo(myThid), myBxHi(myThid)
135			CALL TIMEAVE_RESET(USTRtave, 1, bi, bj, myThid)
136			CALL TIMEAVE_RESET(VSTRtave, 1, bi, bj, myThid)
137			CALL TIMEAVE_RESET(TSRtave, 1, bi, bj, myThid)
138			CALL TIMEAVE_RESET(OLRtave, 1, bi, bj, myThid)
139			CALL TIMEAVE_RESET(SSRtave, 1, bi, bj, myThid)
140			CALL TIMEAVE_RESET(SLRtave, 1, bi, bj, myThid)
141			CALL TIMEAVE_RESET(SHFtave, 1, bi, bj, myThid)
142			CALL TIMEAVE_RESET(EVAPtave, 1, bi, bj, myThid)
143	jmc	1.3	CALL TIMEAVE_RESET(PRECNVtave,1, bi, bj, myThid)
144			CALL TIMEAVE_RESET(PRECLStave,1, bi, bj, myThid)
145			CALL TIMEAVE_RESET(CLOUDCtave,1, bi, bj, myThid)
146			CALL TIMEAVE_RESET(CLTOPtave, 1, bi, bj, myThid)
147			CALL TIMEAVE_RESET(CBMFtave, 1, bi, bj, myThid)
148			CALL TIMEAVE_RESET(DRAGtave, 1, bi, bj, myThid)
149			CALL TIMEAVE_RESET(aimV0tave, 1, bi, bj, myThid)
150			CALL TIMEAVE_RESET(aimT0tave, 1, bi, bj, myThid)
151			CALL TIMEAVE_RESET(aimQ0tave, 1, bi, bj, myThid)
152	jmc	1.6	CALL TIMEAVE_RESET(EnFxPrtave,1, bi, bj, myThid)
153	jmc	1.7	CALL TIMEAVE_RESET(albedotave,1, bi, bj, myThid)
154			CALL TIMEAVE_RESET(dTsurftave,1, bi, bj, myThid)
155	jmc	1.3	CALL TIMEAVE_RESET(aimRHtave,Nr, bi, bj, myThid)
156			DO k=1,Nr
157			aim_timeAve(k,bi,bj) = 0.
158			ENDDO
159	jmc	1.1	ENDDO
160			ENDDO
161	jmc	1.3	#endif /* ALLOW_AIM_TAVE */
162	jmc	1.1
163			#endif /* ALLOW_AIM */
164
165			RETURN
166			END