pkg/seaice/groatb.F

C $Header: $
C $Name: $

#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 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

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