1 |
C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_sice2aim.F,v 1.7 2006/03/13 04:00:10 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "AIM_OPTIONS.h" |
5 |
#ifdef ALLOW_THSICE |
6 |
#include "THSICE_OPTIONS.h" |
7 |
#endif |
8 |
|
9 |
CBOP |
10 |
C !ROUTINE: AIM_SICE2AIM |
11 |
C !INTERFACE: |
12 |
SUBROUTINE AIM_SICE2AIM( |
13 |
I land_frc, |
14 |
U aimTsoce, aimSIfrc, |
15 |
O aimTsice, aimAlb, |
16 |
I myTime, myIter, bi, bj, myThid ) |
17 |
|
18 |
C !DESCRIPTION: \bv |
19 |
C *================================================================* |
20 |
C | S/R AIM_SICE2AIM |
21 |
C | provide surface Boundary Conditions over sea-ice |
22 |
C | (from thsice pkg) to atmospheric physics package AIM |
23 |
C *================================================================* |
24 |
C *================================================================* |
25 |
C \ev |
26 |
|
27 |
C !USES: |
28 |
IMPLICIT NONE |
29 |
|
30 |
C == Global variables === |
31 |
C-- size for MITgcm & Physics package : |
32 |
#include "AIM_SIZE.h" |
33 |
|
34 |
C-- MITgcm |
35 |
#include "EEPARAMS.h" |
36 |
#include "PARAMS.h" |
37 |
|
38 |
C-- Physics package |
39 |
#include "AIM_PARAMS.h" |
40 |
#include "com_forcon.h" |
41 |
|
42 |
#ifdef ALLOW_THSICE |
43 |
C-- Sea-Ice package |
44 |
#include "THSICE_SIZE.h" |
45 |
#include "THSICE_PARAMS.h" |
46 |
#include "THSICE_VARS.h" |
47 |
#include "THSICE_TAVE.h" |
48 |
INTEGER siLo, siHi, sjLo, sjHi |
49 |
PARAMETER ( siLo = 1-OLx , siHi = sNx+OLx ) |
50 |
PARAMETER ( sjLo = 1-OLy , sjHi = sNy+OLy ) |
51 |
#endif |
52 |
|
53 |
#ifdef COMPONENT_MODULE |
54 |
# include "CPL_PARAMS.h" |
55 |
#else |
56 |
LOGICAL cpl_earlyExpImpCall |
57 |
#endif |
58 |
|
59 |
C !INPUT/OUTPUT PARAMETERS: |
60 |
C == Routine arguments == |
61 |
C land_frc :: land fraction [0-1] |
62 |
C aimTsoce :: sea surface temp [K], used in AIM |
63 |
C aimSIfrc :: sea-ice fraction [0-1] |
64 |
C aimTsice :: sea-ice (or snow) surface temp (K), used in AIM |
65 |
C aimAlb :: sea-ice albedo [0-1], used in AIM |
66 |
C myTime :: Current time of simulation ( s ) |
67 |
C myIter :: Current iteration number in simulation |
68 |
C bi,bj :: Tile index |
69 |
C myThid :: Number of this instance of the routine |
70 |
_RS land_frc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
71 |
_RL aimTsoce(sNx,sNy) |
72 |
_RL aimSIfrc(sNx,sNy) |
73 |
_RL aimTsice(sNx,sNy) |
74 |
_RL aimAlb(sNx,sNy) |
75 |
INTEGER myIter, bi, bj, myThid |
76 |
_RL myTime |
77 |
CEOP |
78 |
|
79 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
80 |
|
81 |
#ifdef ALLOW_AIM |
82 |
#ifdef ALLOW_THSICE |
83 |
|
84 |
C == Local variables == |
85 |
C i,j :: Loop counters |
86 |
INTEGER i,j |
87 |
|
88 |
IF ( .TRUE. ) THEN |
89 |
C- Use thsice-pkg output instead of prescribed Temp & ice fraction |
90 |
DO j=1,sNy |
91 |
DO i=1,sNx |
92 |
aimTsice(i,j) = Tsrf(i,j,bi,bj)+celsius2K |
93 |
aimSIfrc(i,j) = iceMask(i,j,bi,bj) |
94 |
ENDDO |
95 |
ENDDO |
96 |
ELSE |
97 |
C- Fill in thsice-pkg Temp. using AIM surf. fields |
98 |
DO j=1,sNy |
99 |
DO i=1,sNx |
100 |
Tsrf (i,j,bi,bj) = aimTsice(i,j)-celsius2K |
101 |
Tice1(i,j,bi,bj) = Tsrf (i,j,bi,bj) |
102 |
Tice2(i,j,bi,bj) = Tsrf (i,j,bi,bj) |
103 |
iceMask(i,j,bi,bj) = aimSIfrc(i,j) |
104 |
ENDDO |
105 |
ENDDO |
106 |
ENDIF |
107 |
|
108 |
IF ( .TRUE. ) THEN |
109 |
C- Compute albedo over sea-ice |
110 |
CALL THSICE_ALBEDO( |
111 |
I bi, bj, siLo, siHi, sjLo, sjHi, |
112 |
I 1, sNx, 1, sNy, |
113 |
I iceMask(siLo,sjLo,bi,bj), iceHeight(siLo,sjLo,bi,bj), |
114 |
I snowHeight(siLo,sjLo,bi,bj), Tsrf(siLo,sjLo,bi,bj), |
115 |
I snowAge(siLo,sjLo,bi,bj), |
116 |
O siceAlb(siLo,sjLo,bi,bj), |
117 |
I myTime, myIter, myThid ) |
118 |
DO j=1,sNy |
119 |
DO i=1,sNx |
120 |
aimAlb(i,j) = siceAlb(i,j,bi,bj) |
121 |
ENDDO |
122 |
ENDDO |
123 |
ELSE |
124 |
C- Surface Albedo : (from F.M. FORDATE S/R) |
125 |
DO j=1,sNy |
126 |
DO i=1,sNx |
127 |
aimAlb(i,j) = ALBICE |
128 |
ENDDO |
129 |
ENDDO |
130 |
ENDIF |
131 |
|
132 |
C-- fill in ocean mixed layer variables |
133 |
C notes: this replace reading initial conditions from files. |
134 |
C needs to be done before call to phy_driver (since freezing |
135 |
C temp. is fct of salinity) ; but would be better somewhere else. |
136 |
IF ( tauRelax_MxL .EQ. -1. _d 0 |
137 |
& .OR. ( stepFwd_oceMxL .AND. StartIceModel.NE.0 |
138 |
& .AND. myIter.EQ.nIter0 ) |
139 |
& .OR. ( myIter.EQ.0 .AND. myTime.EQ.baseTime .AND. |
140 |
& .NOT.(useCoupler.AND.cpl_earlyExpImpCall) ) |
141 |
& ) THEN |
142 |
DO j=1,sNy |
143 |
DO i=1,sNx |
144 |
IF ( land_frc(i,j,bi,bj) .LT. 1. _d 0 ) THEN |
145 |
tOceMxL(i,j,bi,bj) = aimTsoce(i,j)-celsius2K |
146 |
sOceMxL(i,j,bi,bj) = sMxL_default |
147 |
ENDIF |
148 |
ENDDO |
149 |
ENDDO |
150 |
IF ( myIter.EQ.nIter0 ) THEN |
151 |
C-- Over-write the initial T,S_MxL files with the correct fields |
152 |
CALL WRITE_LOCAL_RL( 'ice_tOceMxL', 'I10', 1, |
153 |
& tOceMxL(1-Olx,1-Oly,bi,bj), |
154 |
& bi, bj, 1, myIter, myThid ) |
155 |
CALL WRITE_LOCAL_RL( 'ice_sOceMxL', 'I10', 1, |
156 |
& sOceMxL(1-Olx,1-Oly,bi,bj), |
157 |
& bi, bj, 1, myIter, myThid ) |
158 |
ENDIF |
159 |
ELSE |
160 |
C-- Use ocean mixed layer Temp as Atmos. SST (instead of prescribed Temp) |
161 |
DO j=1,sNy |
162 |
DO i=1,sNx |
163 |
IF ( land_frc(i,j,bi,bj) .LT. 1. _d 0 ) THEN |
164 |
aimTsoce(i,j) = tOceMxL(i,j,bi,bj)+celsius2K |
165 |
ENDIF |
166 |
ENDDO |
167 |
ENDDO |
168 |
ENDIF |
169 |
|
170 |
#endif /* ALLOW_THSICE */ |
171 |
#endif /* ALLOW_AIM */ |
172 |
|
173 |
RETURN |
174 |
END |