pkg/seaice/groatb.F

C $Header:

#include "SEAICE_OPTIONS.h"
 
CStartOfInterface
      SUBROUTINE groatb( A22, myThid )
C     /==========================================================\
C     | SUBROUTINE groatb                                        |
C     | o Calculate ice growth                                   |
C     |==========================================================|
C     \==========================================================/
      IMPLICIT NONE
 
C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DYNVARS.h"
#include "FFIELDS.h"
#include "SEAICE.h"
#include "SEAICE_FFIELDS.h"

#ifdef ALLOW_AUTODIFF_TAMC
# include "tamc.h"
#endif

       COMMON /SEAICE_BOUND_RL/
     &    MAX_HEFF, MIN_ATEMP, MIN_LWDOWN, MAX_TICE, MIN_TICE,
     &    SEAICE_EPS, SEAICE_EPS_SQ
      _RL SEAICE_EPS, SEAICE_EPS_SQ
      _RL MAX_HEFF, MIN_ATEMP, MIN_LWDOWN, MAX_TICE, MIN_TICE

C     === Routine arguments ===
C     myThid - Thread no. that called this routine.
      _RL A22
      INTEGER myThid
CEndOfInterface
 
#ifdef ALLOW_SEAICE

C     === Local variables ===
C     i,j,bi,bj - Loop counters

      INTEGER i, j, bi, bj
      INTEGER KOPEN
      _RL U1, V1, SPEED_SQ
      _RL HICE (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
      _RL UG   (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)

#ifdef SEAICE_MULTILEVEL
      INTEGER it
      _RL RK
      _RL HICEP(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
      _RL FICEP(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
#endif

C if this is not done before then do it here
      _EXCH_XY_R8(UWIND, myThid)
      _EXCH_XY_R8(VWIND, myThid)

CADJ loop = parallel
      DO bj=myByLo(myThid),myByHi(myThid)
CADJ loop = parallel
       DO bi=myBxLo(myThid),myBxHi(myThid)
cph(
#ifdef ALLOW_AUTODIFF_TAMC
          act1 = bi - myBxLo(myThid)
          max1 = myBxHi(myThid) - myBxLo(myThid) + 1
          act2 = bj - myByLo(myThid)
          max2 = myByHi(myThid) - myByLo(myThid) + 1
          act3 = myThid - 1
          max3 = nTx*nTy
          act4 = ikey_dynamics - 1
          iicekey = (act1 + 1) + act2*max1
     &                      + act3*max1*max2
     &                      + act4*max1*max2*max3
#endif /* ALLOW_AUTODIFF_TAMC */
c
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj, 
CADJ &                         key = iicekey, byte = isbyte
#endif /* ALLOW_AUTODIFF_TAMC */
cph)

C DETERMINE AMOUNT OF OPEN WATER AND ICE THICKNESS
        DO J=1,sNy
         DO I=1,sNx
          AREA(I,J,2,bi,bj)=MAX(A22,AREA(I,J,2,bi,bj))
          FHEFF(I,J,bi,bj)=0.0 _d 0
#ifdef SEAICE_MULTILEVEL
          FICEP(I,J)=0.0 _d 0
#endif
         ENDDO
        ENDDO
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj, 
CADJ &                         key = iicekey, byte = isbyte
#endif /* ALLOW_AUTODIFF_TAMC */
        DO J=1,sNy
         DO I=1,sNx
          HICE(I,J)=HEFF(I,J,2,bi,bj)/AREA(I,J,2,bi,bj)
         ENDDO
        ENDDO

C NOW DETERMINE MIXED LAYER TEMPERATURE
        DO J=1,sNy
         DO I=1,sNx
          TMIX(I,J,bi,bj)=theta(I,J,1,bi,bj)+273.16 _d +00
#ifdef SEAICE_DEBUG
          TMIX(I,J,bi,bj)=MAX(TMIX(I,J,bi,bj),271.2 _d +00)
#endif
         ENDDO
        ENDDO

        DO J=1,sNy
         DO I=1,sNx
          U1=0.25 _d 0*(UWIND(I+1,J+1,bi,bj)+UWIND(I+1,J,bi,bj)
     1      +UWIND(I,J+1,bi,bj)+UWIND(I,J,bi,bj))
          V1=0.25 _d 0*(VWIND(I+1,J+1,bi,bj)+VWIND(I+1,J,bi,bj)
     1      +VWIND(I,J+1,bi,bj)+VWIND(I,J,bi,bj))
          SPEED_SQ = U1**2 + V1**2
          IF ( SPEED_SQ .LE. SEAICE_EPS_SQ ) THEN
             UG(I,J)=SEAICE_EPS
          ELSE
             UG(I,J)=SQRT(SPEED_SQ)
          ENDIF
         ENDDO
        ENDDO

#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE atemp(:,:,bi,bj)  = comlev1_bibj, 
CADJ &                           key = iicekey, byte = isbyte
CADJ STORE lwdown(:,:,bi,bj) = comlev1_bibj, 
CADJ &                           key = iicekey, byte = isbyte
#endif /* ALLOW_AUTODIFF_TAMC */
C NOW DETERMINE GROWTH RATES
C FIRST DO OPEN WATER
        KOPEN=-1
        CALL BUDGET(UG, TMIX, HICE, FO, KOPEN, bi, bj)

#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE atemp(:,:,bi,bj)  = comlev1_bibj, 
CADJ &                           key = iicekey, byte = isbyte
CADJ STORE lwdown(:,:,bi,bj) = comlev1_bibj, 
CADJ &                           key = iicekey, byte = isbyte
#endif /* ALLOW_AUTODIFF_TAMC */
C NOW DO ICE
        KOPEN=1
#ifdef SEAICE_MULTILEVEL
        DO IT=1,7
         DO J=1,sNy
          DO I=1,sNx
           RK=IT*1.0
           HICEP(I,J)=(HICE(I,J)/7.0 _d 0)*((2.0 _d 0*RK)-1.0 _d 0)
           TICE(I,J,bi,bj)=TICES(I,J,IT,bi,bj)
          ENDDO
         ENDDO
         CALL BUDGET(UG, TICE, HICEP, FICE, KOPEN, bi, bj)
         DO J=1,sNy
          DO I=1,sNx
           FICEP(I,J)=(FICE(I,J,bi,bj)/7.0 _d 0)+FICEP(I,J)
           TICES(I,J,IT,bi,bj)=TICE(I,J,bi,bj)
          ENDDO
         ENDDO
        ENDDO
        DO J=1,sNy
         DO I=1,sNx
          FICE(I,J,bi,bj)=FICEP(I,J)
         ENDDO
        ENDDO
#else  /* SEAICE_MULTILEVEL */
        CALL BUDGET(UG, TICE, HICE, FICE, KOPEN, bi, bj)
#endif /* SEAICE_MULTILEVEL */

       ENDDO
      ENDDO

#endif /* ALLOW_SEAICE */

      RETURN
      END
1	heimbach	1.2	C $Header:
2
3			#include "SEAICE_OPTIONS.h"
4
5			CStartOfInterface
6			SUBROUTINE groatb( A22, myThid )
7			C /==========================================================\
8			C \| SUBROUTINE groatb \|
9			C \| o Calculate ice growth \|
10			C \|==========================================================\|
11			C \==========================================================/
12			IMPLICIT NONE
13
14			C === Global variables ===
15			#include "SIZE.h"
16			#include "EEPARAMS.h"
17			#include "PARAMS.h"
18			#include "DYNVARS.h"
19			#include "FFIELDS.h"
20			#include "SEAICE.h"
21			#include "SEAICE_FFIELDS.h"
22	dimitri	1.4.4.8
23			#ifdef ALLOW_AUTODIFF_TAMC
24			# include "tamc.h"
25			#endif
26
27	dimitri	1.4.4.5	COMMON /SEAICE_BOUND_RL/
28			& MAX_HEFF, MIN_ATEMP, MIN_LWDOWN, MAX_TICE, MIN_TICE,
29			& SEAICE_EPS, SEAICE_EPS_SQ
30			_RL SEAICE_EPS, SEAICE_EPS_SQ
31			_RL MAX_HEFF, MIN_ATEMP, MIN_LWDOWN, MAX_TICE, MIN_TICE
32
33	heimbach	1.2	C === Routine arguments ===
34			C myThid - Thread no. that called this routine.
35			_RL A22
36			INTEGER myThid
37			CEndOfInterface
38
39			#ifdef ALLOW_SEAICE
40
41			C === Local variables ===
42	dimitri	1.4	C i,j,bi,bj - Loop counters
43	heimbach	1.2
44	dimitri	1.4	INTEGER i, j, bi, bj
45	heimbach	1.2	INTEGER KOPEN
46	dimitri	1.4.4.3	_RL U1, V1, SPEED_SQ
47	heimbach	1.2	_RL HICE (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
48			_RL UG (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
49
50	dimitri	1.4.4.7	#ifdef SEAICE_MULTILEVEL
51			INTEGER it
52			_RL RK
53			_RL HICEP(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
54			_RL FICEP(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
55			#endif
56
57	heimbach	1.2	C if this is not done before then do it here
58	dimitri	1.4	_EXCH_XY_R8(UWIND, myThid)
59			_EXCH_XY_R8(VWIND, myThid)
60	heimbach	1.2
61	dimitri	1.4.4.8	CADJ loop = parallel
62	heimbach	1.2	DO bj=myByLo(myThid),myByHi(myThid)
63	dimitri	1.4.4.8	CADJ loop = parallel
64	heimbach	1.2	DO bi=myBxLo(myThid),myBxHi(myThid)
65	dimitri	1.4.4.8	cph(
66			#ifdef ALLOW_AUTODIFF_TAMC
67			act1 = bi - myBxLo(myThid)
68			max1 = myBxHi(myThid) - myBxLo(myThid) + 1
69			act2 = bj - myByLo(myThid)
70			max2 = myByHi(myThid) - myByLo(myThid) + 1
71			act3 = myThid - 1
72			max3 = nTx*nTy
73			act4 = ikey_dynamics - 1
74			iicekey = (act1 + 1) + act2*max1
75			& + act3max1max2
76			& + act4max1max2*max3
77			#endif /* ALLOW_AUTODIFF_TAMC */
78			c
79			#ifdef ALLOW_AUTODIFF_TAMC
80			CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
81			CADJ & key = iicekey, byte = isbyte
82			#endif /* ALLOW_AUTODIFF_TAMC */
83			cph)
84	heimbach	1.2
85			C DETERMINE AMOUNT OF OPEN WATER AND ICE THICKNESS
86			DO J=1,sNy
87			DO I=1,sNx
88			AREA(I,J,2,bi,bj)=MAX(A22,AREA(I,J,2,bi,bj))
89	dimitri	1.3	FHEFF(I,J,bi,bj)=0.0 _d 0
90	dimitri	1.4.4.7	#ifdef SEAICE_MULTILEVEL
91			FICEP(I,J)=0.0 _d 0
92			#endif
93	dimitri	1.4.4.8	ENDDO
94			ENDDO
95			#ifdef ALLOW_AUTODIFF_TAMC
96			CADJ STORE area(:,:,:,bi,bj) = comlev1_bibj,
97			CADJ & key = iicekey, byte = isbyte
98			#endif /* ALLOW_AUTODIFF_TAMC */
99			DO J=1,sNy
100			DO I=1,sNx
101	heimbach	1.2	HICE(I,J)=HEFF(I,J,2,bi,bj)/AREA(I,J,2,bi,bj)
102			ENDDO
103			ENDDO
104
105			C NOW DETERMINE MIXED LAYER TEMPERATURE
106			DO J=1,sNy
107			DO I=1,sNx
108	dimitri	1.3	TMIX(I,J,bi,bj)=theta(I,J,1,bi,bj)+273.16 _d +00
109	heimbach	1.2	#ifdef SEAICE_DEBUG
110	dimitri	1.3	TMIX(I,J,bi,bj)=MAX(TMIX(I,J,bi,bj),271.2 _d +00)
111	dimitri	1.4.4.2	#endif
112	heimbach	1.2	ENDDO
113			ENDDO
114
115			DO J=1,sNy
116			DO I=1,sNx
117	dimitri	1.4.4.6	U1=0.25 _d 0*(UWIND(I+1,J+1,bi,bj)+UWIND(I+1,J,bi,bj)
118			1 +UWIND(I,J+1,bi,bj)+UWIND(I,J,bi,bj))
119			V1=0.25 _d 0*(VWIND(I+1,J+1,bi,bj)+VWIND(I+1,J,bi,bj)
120			1 +VWIND(I,J+1,bi,bj)+VWIND(I,J,bi,bj))
121	dimitri	1.4.4.3	SPEED_SQ = U12 + V12
122	dimitri	1.4.4.7	IF ( SPEED_SQ .LE. SEAICE_EPS_SQ ) THEN
123	dimitri	1.4.4.3	UG(I,J)=SEAICE_EPS
124			ELSE
125			UG(I,J)=SQRT(SPEED_SQ)
126			ENDIF
127	heimbach	1.2	ENDDO
128			ENDDO
129
130	dimitri	1.4.4.8	#ifdef ALLOW_AUTODIFF_TAMC
131			CADJ STORE atemp(:,:,bi,bj) = comlev1_bibj,
132			CADJ & key = iicekey, byte = isbyte
133			CADJ STORE lwdown(:,:,bi,bj) = comlev1_bibj,
134			CADJ & key = iicekey, byte = isbyte
135			#endif /* ALLOW_AUTODIFF_TAMC */
136	heimbach	1.2	C NOW DETERMINE GROWTH RATES
137			C FIRST DO OPEN WATER
138			KOPEN=-1
139			CALL BUDGET(UG, TMIX, HICE, FO, KOPEN, bi, bj)
140	dimitri	1.4.4.8
141			#ifdef ALLOW_AUTODIFF_TAMC
142			CADJ STORE atemp(:,:,bi,bj) = comlev1_bibj,
143			CADJ & key = iicekey, byte = isbyte
144			CADJ STORE lwdown(:,:,bi,bj) = comlev1_bibj,
145			CADJ & key = iicekey, byte = isbyte
146			#endif /* ALLOW_AUTODIFF_TAMC */
147	heimbach	1.2	C NOW DO ICE
148			KOPEN=1
149	dimitri	1.4.4.7	#ifdef SEAICE_MULTILEVEL
150			DO IT=1,7
151			DO J=1,sNy
152			DO I=1,sNx
153			RK=IT*1.0
154			HICEP(I,J)=(HICE(I,J)/7.0 _d 0)((2.0 _d 0RK)-1.0 _d 0)
155			TICE(I,J,bi,bj)=TICES(I,J,IT,bi,bj)
156			ENDDO
157			ENDDO
158			CALL BUDGET(UG, TICE, HICEP, FICE, KOPEN, bi, bj)
159			DO J=1,sNy
160			DO I=1,sNx
161			FICEP(I,J)=(FICE(I,J,bi,bj)/7.0 _d 0)+FICEP(I,J)
162			TICES(I,J,IT,bi,bj)=TICE(I,J,bi,bj)
163			ENDDO
164			ENDDO
165			ENDDO
166			DO J=1,sNy
167			DO I=1,sNx
168			FICE(I,J,bi,bj)=FICEP(I,J)
169			ENDDO
170			ENDDO
171			#else /* SEAICE_MULTILEVEL */
172	heimbach	1.2	CALL BUDGET(UG, TICE, HICE, FICE, KOPEN, bi, bj)
173	dimitri	1.4.4.7	#endif /* SEAICE_MULTILEVEL */
174	heimbach	1.2
175			ENDDO
176			ENDDO
177
178	dimitri	1.4.4.2	#endif /* ALLOW_SEAICE */
179	heimbach	1.2
180			RETURN
181			END