pkg/land/land_ini_vars.F

C $Header: /u/gcmpack/MITgcm/pkg/land/land_ini_vars.F,v 1.5 2005/04/06 18:41:51 jmc Exp $
C $Name:  $

#include "LAND_OPTIONS.h"

CBOP
C     !ROUTINE: LAND_INI_VARS
C     !INTERFACE:
      SUBROUTINE LAND_INI_VARS( myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R LAND_INI_VARS
C     | o Initialize Land package variables
C     *==========================================================*
C     | for now, used only for a restart
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

C     == Global variables ===

C-- size for MITgcm & Land package :
#include "LAND_SIZE.h"

#include "EEPARAMS.h"
#include "PARAMS.h"
#include "LAND_PARAMS.h"
#include "LAND_VARS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine Arguments ==
C     myThid -  Number of this instance
      INTEGER myThid
CEOP

#ifdef ALLOW_LAND

C     == Local Variables ==
C     msgBuf      - Informational/error meesage buffer
C     i,j,k,bi,bj :: loop indices
C     grd_HeatCp   :: Heat capacity of the ground (J/m3/K)
C     mWater       :: water content of the ground (kg/m3)
C     temp_af      :: ground temperature if above freezing
C     temp_bf      :: ground temperature if below freezing
c     CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER i,j,k,bi,bj
      _RL grd_HeatCp, mWater
      _RL temp_af, temp_bf

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

C--   Initialize Land package variables

C-    Over all tiles
      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)

C-      3D arrays
        DO k=1,land_nLev
         DO J=1-Oly,sNy+Oly
          DO I=1-Olx,sNx+Olx
           land_groundT(i,j,k,bi,bj) = 0. _d 0
           land_enthalp(i,j,k,bi,bj) = 0. _d 0
           land_groundW(i,j,k,bi,bj) = 0. _d 0
          ENDDO
         ENDDO
        ENDDO

C-      2D arrays
        DO J=1-Oly,sNy+Oly
         DO I=1-Olx,sNx+Olx
           land_skinT  (i,j,bi,bj) = 0. _d 0
           land_hSnow  (i,j,bi,bj) = 0. _d 0
           land_snowAge(i,j,bi,bj) = 0. _d 0
           land_runOff (i,j,bi,bj) = 0. _d 0
           land_enRnOf (i,j,bi,bj) = 0. _d 0
           land_HeatFLx(i,j,bi,bj) = 0. _d 0
           land_Pr_m_Ev(i,j,bi,bj) = 0. _d 0
           land_EnWFlux(i,j,bi,bj) = 0. _d 0
         ENDDO
        ENDDO

C-     end bi,bj loops
       ENDDO
      ENDDO

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

C-    Need to synchronize here before doing master-thread IO
      _BARRIER

      IF ( startTime.EQ.baseTime .AND. nIter0.EQ.0 ) THEN

C--   Define the initial state : read from file
       IF ( land_grT_iniFile .NE. ' ' ) THEN
        CALL MDSREADFIELD( land_grT_iniFile, readBinaryPrec, 'RL',
     &                     land_nLev, land_groundT, 1, myThid)
       ENDIF
       IF ( land_grW_iniFile .NE. ' ' ) THEN
        CALL MDSREADFIELD( land_grW_iniFile, readBinaryPrec, 'RL',
     &                     land_nLev, land_groundW, 1, myThid)
       ENDIF
       IF ( land_snow_iniFile .NE. ' ' ) THEN
        CALL MDSREADFIELD( land_snow_iniFile,readBinaryPrec, 'RL',
     &                     1, land_hSnow, 1, myThid)
       ENDIF

      ELSEIF ( land_calc_grT .OR. land_calc_grW ) THEN

C--   Read Land package state variables from pickup file
        CALL LAND_READ_PICKUP( nIter0, myThid )

c     ELSE
C-    a trick to allow to start without a land pickup:
C        load grT & grW from AIM surf. BC in S/R aim_land2aim
      ENDIF

C-    Every one else must wait until loading is done.
      _BARRIER

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

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

C-     to have a consistent initial state: set surface Temp & enthalpy
C       assuming all the water in 1 phase only (solid or liquid):
        IF ( ( startTime.EQ.baseTime .AND. nIter0.EQ.0 ) .OR.
     &   .NOT.( land_calc_grT .OR. land_calc_grW ) .OR.
     &       land_oldPickup ) THEN
         DO j=1,sNy
          DO i=1,sNx
c          IF ( land_frc(i,j,bi,bj).GT.0. ) THEN
            DO k=1,land_nLev
             mWater = land_rhoLiqW*land_waterCap
     &               *land_groundW(i,j,k,bi,bj)
             grd_HeatCp = land_heatCs + land_CpWater*mWater
             land_enthalp(i,j,k,bi,bj) =
     &                     grd_HeatCp*land_groundT(i,j,k,bi,bj)
             IF (land_groundT(i,j,k,bi,bj).LT. 0. _d 0)
     &       land_enthalp(i,j,k,bi,bj) = land_enthalp(i,j,k,bi,bj)
     &                                 - land_Lfreez*mWater
            ENDDO
             land_skinT(i,j,bi,bj) = land_groundT(i,j,1,bi,bj)
c          ENDIF
          ENDDO
         ENDDO
        ELSE
         DO j=1,sNy
          DO i=1,sNx
            DO k=1,land_nLev
             mWater = land_rhoLiqW*land_waterCap
     &               *land_groundW(i,j,k,bi,bj)
             grd_HeatCp = land_heatCs + land_CpWater*mWater
C         temperature if below freezing:
             temp_bf = (land_enthalp(i,j,k,bi,bj)+land_Lfreez*mWater)
     &                                            / grd_HeatCp
C         temperature if above freezing:
             temp_af =  land_enthalp(i,j,k,bi,bj) / grd_HeatCp
             land_groundT(i,j,k,bi,bj) =
     &               MIN( temp_bf, MAX(temp_af, 0. _d 0) )
            ENDDO
          ENDDO
         ENDDO
        ENDIF

C-     end bi,bj loops
       ENDDO
      ENDDO

#endif /* ALLOW_LAND */

      RETURN
      END
1	jmc	1.6	C $Header: /u/gcmpack/MITgcm/pkg/land/land_ini_vars.F,v 1.5 2005/04/06 18:41:51 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "LAND_OPTIONS.h"
5
6			CBOP
7			C !ROUTINE: LAND_INI_VARS
8			C !INTERFACE:
9			SUBROUTINE LAND_INI_VARS( myThid )
10
11			C !DESCRIPTION: \bv
12			C ==========================================================
13			C \| S/R LAND_INI_VARS
14			C \| o Initialize Land package variables
15			C ==========================================================
16			C \| for now, used only for a restart
17			C ==========================================================
18			C \ev
19	jmc	1.6
20	jmc	1.1	C !USES:
21			IMPLICIT NONE
22
23			C == Global variables ===
24
25			C-- size for MITgcm & Land package :
26			#include "LAND_SIZE.h"
27
28			#include "EEPARAMS.h"
29			#include "PARAMS.h"
30			#include "LAND_PARAMS.h"
31	jmc	1.2	#include "LAND_VARS.h"
32	jmc	1.1
33			C !INPUT/OUTPUT PARAMETERS:
34	jmc	1.6	C == Routine Arguments ==
35	jmc	1.1	C myThid - Number of this instance
36			INTEGER myThid
37			CEOP
38
39			#ifdef ALLOW_LAND
40
41	jmc	1.6	C == Local Variables ==
42	jmc	1.1	C msgBuf - Informational/error meesage buffer
43	jmc	1.3	C i,j,k,bi,bj :: loop indices
44			C grd_HeatCp :: Heat capacity of the ground (J/m3/K)
45			C mWater :: water content of the ground (kg/m3)
46			C temp_af :: ground temperature if above freezing
47			C temp_bf :: ground temperature if below freezing
48	jmc	1.1	c CHARACTER*(MAX_LEN_MBUF) msgBuf
49	jmc	1.3	INTEGER i,j,k,bi,bj
50			_RL grd_HeatCp, mWater
51			_RL temp_af, temp_bf
52	jmc	1.1
53			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
54
55	jmc	1.3	C-- Initialize Land package variables
56
57			C- Over all tiles
58			DO bj = myByLo(myThid), myByHi(myThid)
59			DO bi = myBxLo(myThid), myBxHi(myThid)
60
61			C- 3D arrays
62			DO k=1,land_nLev
63			DO J=1-Oly,sNy+Oly
64			DO I=1-Olx,sNx+Olx
65			land_groundT(i,j,k,bi,bj) = 0. _d 0
66			land_enthalp(i,j,k,bi,bj) = 0. _d 0
67			land_groundW(i,j,k,bi,bj) = 0. _d 0
68			ENDDO
69			ENDDO
70			ENDDO
71
72			C- 2D arrays
73			DO J=1-Oly,sNy+Oly
74			DO I=1-Olx,sNx+Olx
75			land_skinT (i,j,bi,bj) = 0. _d 0
76			land_hSnow (i,j,bi,bj) = 0. _d 0
77			land_snowAge(i,j,bi,bj) = 0. _d 0
78			land_runOff (i,j,bi,bj) = 0. _d 0
79			land_enRnOf (i,j,bi,bj) = 0. _d 0
80			land_HeatFLx(i,j,bi,bj) = 0. _d 0
81			land_Pr_m_Ev(i,j,bi,bj) = 0. _d 0
82			land_EnWFlux(i,j,bi,bj) = 0. _d 0
83			ENDDO
84			ENDDO
85
86			C- end bi,bj loops
87			ENDDO
88			ENDDO
89
90			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
91	jmc	1.2
92	jmc	1.6	C- Need to synchronize here before doing master-thread IO
93			_BARRIER
94
95	jmc	1.5	IF ( startTime.EQ.baseTime .AND. nIter0.EQ.0 ) THEN
96	jmc	1.1
97	jmc	1.2	C-- Define the initial state : read from file
98			IF ( land_grT_iniFile .NE. ' ' ) THEN
99			CALL MDSREADFIELD( land_grT_iniFile, readBinaryPrec, 'RL',
100			& land_nLev, land_groundT, 1, myThid)
101			ENDIF
102			IF ( land_grW_iniFile .NE. ' ' ) THEN
103			CALL MDSREADFIELD( land_grW_iniFile, readBinaryPrec, 'RL',
104			& land_nLev, land_groundW, 1, myThid)
105			ENDIF
106	jmc	1.3	IF ( land_snow_iniFile .NE. ' ' ) THEN
107			CALL MDSREADFIELD( land_snow_iniFile,readBinaryPrec, 'RL',
108			& 1, land_hSnow, 1, myThid)
109			ENDIF
110	jmc	1.1
111			ELSEIF ( land_calc_grT .OR. land_calc_grW ) THEN
112
113			C-- Read Land package state variables from pickup file
114			CALL LAND_READ_PICKUP( nIter0, myThid )
115
116	jmc	1.2	c ELSE
117			C- a trick to allow to start without a land pickup:
118			C load grT & grW from AIM surf. BC in S/R aim_land2aim
119	jmc	1.1	ENDIF
120	jmc	1.3
121	jmc	1.6	C- Every one else must wait until loading is done.
122			_BARRIER
123
124			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
125
126	jmc	1.3	DO bj=myByLo(myThid),myByHi(myThid)
127			DO bi=myBxLo(myThid),myBxHi(myThid)
128
129	jmc	1.4	C- to have a consistent initial state: set surface Temp & enthalpy
130			C assuming all the water in 1 phase only (solid or liquid):
131	jmc	1.5	IF ( ( startTime.EQ.baseTime .AND. nIter0.EQ.0 ) .OR.
132	jmc	1.3	& .NOT.( land_calc_grT .OR. land_calc_grW ) .OR.
133			& land_oldPickup ) THEN
134			DO j=1,sNy
135			DO i=1,sNx
136			c IF ( land_frc(i,j,bi,bj).GT.0. ) THEN
137			DO k=1,land_nLev
138			mWater = land_rhoLiqW*land_waterCap
139			& *land_groundW(i,j,k,bi,bj)
140			grd_HeatCp = land_heatCs + land_CpWater*mWater
141	jmc	1.6	land_enthalp(i,j,k,bi,bj) =
142	jmc	1.3	& grd_HeatCp*land_groundT(i,j,k,bi,bj)
143	jmc	1.6	IF (land_groundT(i,j,k,bi,bj).LT. 0. _d 0)
144	jmc	1.3	& land_enthalp(i,j,k,bi,bj) = land_enthalp(i,j,k,bi,bj)
145			& - land_Lfreez*mWater
146			ENDDO
147			land_skinT(i,j,bi,bj) = land_groundT(i,j,1,bi,bj)
148			c ENDIF
149			ENDDO
150			ENDDO
151	jmc	1.6	ELSE
152	jmc	1.3	DO j=1,sNy
153			DO i=1,sNx
154			DO k=1,land_nLev
155			mWater = land_rhoLiqW*land_waterCap
156			& *land_groundW(i,j,k,bi,bj)
157			grd_HeatCp = land_heatCs + land_CpWater*mWater
158			C temperature if below freezing:
159			temp_bf = (land_enthalp(i,j,k,bi,bj)+land_Lfreez*mWater)
160			& / grd_HeatCp
161			C temperature if above freezing:
162			temp_af = land_enthalp(i,j,k,bi,bj) / grd_HeatCp
163			land_groundT(i,j,k,bi,bj) =
164			& MIN( temp_bf, MAX(temp_af, 0. _d 0) )
165			ENDDO
166			ENDDO
167			ENDDO
168			ENDIF
169
170			C- end bi,bj loops
171			ENDDO
172			ENDDO
173	jmc	1.1
174			#endif /* ALLOW_LAND */
175
176			RETURN
177			END