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"
       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)

c$taf loop = parallel
      DO bj=myByLo(myThid),myByHi(myThid)
c$taf loop = parallel
       DO bi=myBxLo(myThid),myBxHi(myThid)

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
          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 .LT. SEAICE_EPS_SQ ) THEN
             UG(I,J)=SEAICE_EPS
          ELSE
             UG(I,J)=SQRT(SPEED_SQ)
          ENDIF
         ENDDO
        ENDDO

C NOW DETERMINE GROWTH RATES
C FIRST DO OPEN WATER
        KOPEN=-1
        CALL BUDGET(UG, TMIX, HICE, FO, KOPEN, bi, bj)
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.1.2.1	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.1.2.5	COMMON /SEAICE_BOUND_RL/
23			& MAX_HEFF, MIN_ATEMP, MIN_LWDOWN, MAX_TICE, MIN_TICE,
24			& SEAICE_EPS, SEAICE_EPS_SQ
25			_RL SEAICE_EPS, SEAICE_EPS_SQ
26			_RL MAX_HEFF, MIN_ATEMP, MIN_LWDOWN, MAX_TICE, MIN_TICE
27
28	heimbach	1.1.2.1	C === Routine arguments ===
29			C myThid - Thread no. that called this routine.
30			_RL A22
31			INTEGER myThid
32			CEndOfInterface
33
34			#ifdef ALLOW_SEAICE
35
36			C === Local variables ===
37	dimitri	1.1.2.3	C i,j,bi,bj - Loop counters
38	heimbach	1.1.2.1
39	dimitri	1.1.2.3	INTEGER i, j, bi, bj
40	heimbach	1.1.2.1	INTEGER KOPEN
41	dimitri	1.1.2.5	_RL U1, V1, SPEED_SQ
42	heimbach	1.1.2.1	_RL HICE (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
43			_RL UG (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
44
45	dimitri	1.1.2.6.2.1	#ifdef SEAICE_MULTILEVEL
46			INTEGER it
47			_RL RK
48			_RL HICEP(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
49			_RL FICEP(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
50			#endif
51
52	heimbach	1.1.2.1	C if this is not done before then do it here
53	dimitri	1.1.2.3	_EXCH_XY_R8(UWIND, myThid)
54			_EXCH_XY_R8(VWIND, myThid)
55	heimbach	1.1.2.1
56	dimitri	1.1.2.2	c$taf loop = parallel
57	heimbach	1.1.2.1	DO bj=myByLo(myThid),myByHi(myThid)
58	dimitri	1.1.2.2	c$taf loop = parallel
59	heimbach	1.1.2.1	DO bi=myBxLo(myThid),myBxHi(myThid)
60
61			C DETERMINE AMOUNT OF OPEN WATER AND ICE THICKNESS
62			DO J=1,sNy
63			DO I=1,sNx
64			AREA(I,J,2,bi,bj)=MAX(A22,AREA(I,J,2,bi,bj))
65	dimitri	1.1.2.2	FHEFF(I,J,bi,bj)=0.0 _d 0
66	dimitri	1.1.2.6.2.1	#ifdef SEAICE_MULTILEVEL
67			FICEP(I,J)=0.0 _d 0
68			#endif
69	heimbach	1.1.2.1	HICE(I,J)=HEFF(I,J,2,bi,bj)/AREA(I,J,2,bi,bj)
70			ENDDO
71			ENDDO
72
73			C NOW DETERMINE MIXED LAYER TEMPERATURE
74			DO J=1,sNy
75			DO I=1,sNx
76	dimitri	1.1.2.2	TMIX(I,J,bi,bj)=theta(I,J,1,bi,bj)+273.16 _d +00
77	heimbach	1.1.2.1	#ifdef SEAICE_DEBUG
78	dimitri	1.1.2.2	TMIX(I,J,bi,bj)=MAX(TMIX(I,J,bi,bj),271.2 _d +00)
79	dimitri	1.1.2.4	#endif
80	heimbach	1.1.2.1	ENDDO
81			ENDDO
82
83			DO J=1,sNy
84			DO I=1,sNx
85	dimitri	1.1.2.6	U1=0.25 _d 0*(UWIND(I+1,J+1,bi,bj)+UWIND(I+1,J,bi,bj)
86			1 +UWIND(I,J+1,bi,bj)+UWIND(I,J,bi,bj))
87			V1=0.25 _d 0*(VWIND(I+1,J+1,bi,bj)+VWIND(I+1,J,bi,bj)
88			1 +VWIND(I,J+1,bi,bj)+VWIND(I,J,bi,bj))
89	dimitri	1.1.2.5	SPEED_SQ = U12 + V12
90			IF ( SPEED_SQ .LT. SEAICE_EPS_SQ ) THEN
91			UG(I,J)=SEAICE_EPS
92			ELSE
93			UG(I,J)=SQRT(SPEED_SQ)
94			ENDIF
95	heimbach	1.1.2.1	ENDDO
96			ENDDO
97
98			C NOW DETERMINE GROWTH RATES
99			C FIRST DO OPEN WATER
100			KOPEN=-1
101			CALL BUDGET(UG, TMIX, HICE, FO, KOPEN, bi, bj)
102			C NOW DO ICE
103			KOPEN=1
104	dimitri	1.1.2.6.2.1	#ifdef SEAICE_MULTILEVEL
105			DO IT=1,7
106			DO J=1,sNy
107			DO I=1,sNx
108			RK=IT*1.0
109			HICEP(I,J)=(HICE(I,J)/7.0 _d 0)((2.0 _d 0RK)-1.0 _d 0)
110			TICE(I,J,bi,bj)=TICES(I,J,IT,bi,bj)
111			ENDDO
112			ENDDO
113			CALL BUDGET(UG, TICE, HICEP, FICE, KOPEN, bi, bj)
114			DO J=1,sNy
115			DO I=1,sNx
116			FICEP(I,J)=(FICE(I,J,bi,bj)/7.0 _d 0)+FICEP(I,J)
117			TICES(I,J,IT,bi,bj)=TICE(I,J,bi,bj)
118			ENDDO
119			ENDDO
120			ENDDO
121			DO J=1,sNy
122			DO I=1,sNx
123			FICE(I,J,bi,bj)=FICEP(I,J)
124			ENDDO
125			ENDDO
126			#else /* SEAICE_MULTILEVEL */
127	heimbach	1.1.2.1	CALL BUDGET(UG, TICE, HICE, FICE, KOPEN, bi, bj)
128	dimitri	1.1.2.6.2.1	#endif /* SEAICE_MULTILEVEL */
129	heimbach	1.1.2.1
130			ENDDO
131			ENDDO
132
133	dimitri	1.1.2.4	#endif /* ALLOW_SEAICE */
134	heimbach	1.1.2.1
135			RETURN
136			END