1 |
C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_sice2aim.F,v 1.10 2006/08/07 20:20:01 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 |
PARAMETER( cpl_earlyExpImpCall = .FALSE. ) |
58 |
#endif |
59 |
|
60 |
C !INPUT/OUTPUT PARAMETERS: |
61 |
C == Routine arguments == |
62 |
C land_frc :: land fraction [0-1] |
63 |
C aimTsoce :: sea surface temp [K], used in AIM |
64 |
C aimSIfrc :: sea-ice fraction [0-1] |
65 |
C aimTsice :: sea-ice (or snow) surface temp (K), used in AIM |
66 |
C aimAlb :: sea-ice albedo [0-1], used in AIM |
67 |
C myTime :: Current time of simulation ( s ) |
68 |
C myIter :: Current iteration number in simulation |
69 |
C bi,bj :: Tile index |
70 |
C myThid :: Number of this instance of the routine |
71 |
_RS land_frc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
72 |
_RL aimTsoce(sNx,sNy) |
73 |
_RL aimSIfrc(sNx,sNy) |
74 |
_RL aimTsice(sNx,sNy) |
75 |
_RL aimAlb(sNx,sNy) |
76 |
INTEGER myIter, bi, bj, myThid |
77 |
_RL myTime |
78 |
CEOP |
79 |
|
80 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
81 |
|
82 |
#ifdef ALLOW_AIM |
83 |
#ifdef ALLOW_THSICE |
84 |
|
85 |
C == Local variables == |
86 |
C i,j :: Loop counters |
87 |
INTEGER i,j |
88 |
|
89 |
IF ( .TRUE. ) THEN |
90 |
C- Use thsice-pkg output instead of prescribed Temp & ice fraction |
91 |
DO j=1,sNy |
92 |
DO i=1,sNx |
93 |
aimTsice(i,j) = Tsrf(i,j,bi,bj)+celsius2K |
94 |
aimSIfrc(i,j) = iceMask(i,j,bi,bj) |
95 |
ENDDO |
96 |
ENDDO |
97 |
ELSE |
98 |
C- Fill in thsice-pkg Temp. using AIM surf. fields |
99 |
DO j=1,sNy |
100 |
DO i=1,sNx |
101 |
Tsrf (i,j,bi,bj) = aimTsice(i,j)-celsius2K |
102 |
Tice1(i,j,bi,bj) = Tsrf (i,j,bi,bj) |
103 |
Tice2(i,j,bi,bj) = Tsrf (i,j,bi,bj) |
104 |
iceMask(i,j,bi,bj) = aimSIfrc(i,j) |
105 |
ENDDO |
106 |
ENDDO |
107 |
ENDIF |
108 |
|
109 |
IF ( .TRUE. ) THEN |
110 |
C- Compute albedo over sea-ice |
111 |
CALL THSICE_ALBEDO( |
112 |
I bi, bj, siLo, siHi, sjLo, sjHi, |
113 |
I 1, sNx, 1, sNy, |
114 |
I iceMask(siLo,sjLo,bi,bj), iceHeight(siLo,sjLo,bi,bj), |
115 |
I snowHeight(siLo,sjLo,bi,bj), Tsrf(siLo,sjLo,bi,bj), |
116 |
I snowAge(siLo,sjLo,bi,bj), |
117 |
O siceAlb(siLo,sjLo,bi,bj), |
118 |
I myTime, myIter, myThid ) |
119 |
DO j=1,sNy |
120 |
DO i=1,sNx |
121 |
aimAlb(i,j) = siceAlb(i,j,bi,bj) |
122 |
ENDDO |
123 |
ENDDO |
124 |
ELSE |
125 |
C- Surface Albedo : (from F.M. FORDATE S/R) |
126 |
DO j=1,sNy |
127 |
DO i=1,sNx |
128 |
aimAlb(i,j) = ALBICE |
129 |
ENDDO |
130 |
ENDDO |
131 |
ENDIF |
132 |
|
133 |
C-- fill in ocean mixed layer variables |
134 |
C notes: this replace reading initial conditions from files. |
135 |
C needs to be done before call to phy_driver (since freezing |
136 |
C temp. is fct of salinity) ; but would be better somewhere else. |
137 |
IF ( tauRelax_MxL .EQ. -1. _d 0 |
138 |
& .OR. ( stepFwd_oceMxL .AND. StartIceModel.NE.0 |
139 |
& .AND. myIter.EQ.nIter0 ) |
140 |
& .OR. ( myIter.EQ.0 .AND. myTime.EQ.baseTime .AND. |
141 |
& .NOT.(useCoupler.AND.cpl_earlyExpImpCall) ) |
142 |
& ) THEN |
143 |
DO j=1,sNy |
144 |
DO i=1,sNx |
145 |
IF ( land_frc(i,j,bi,bj) .LT. 1. _d 0 ) THEN |
146 |
tOceMxL(i,j,bi,bj) = aimTsoce(i,j)-celsius2K |
147 |
sOceMxL(i,j,bi,bj) = sMxL_default |
148 |
ENDIF |
149 |
ENDDO |
150 |
ENDDO |
151 |
IF ( myIter.EQ.nIter0 ) THEN |
152 |
#ifndef LOCBIN_IO_THREAD_SAFE |
153 |
C- should used a modified MDS_WRITETILE that works in multi-threaded |
154 |
C with array in common block. For now, just do nothing. |
155 |
IF ( nThreads.EQ.1 ) THEN |
156 |
#endif |
157 |
C-- Over-write the initial T,S_MxL files with the correct fields |
158 |
CALL WRITE_LOCAL_RL( 'ice_tOceMxL', 'I10', 1, |
159 |
& tOceMxL(1-Olx,1-Oly,bi,bj), |
160 |
& bi, bj, 1, myIter, myThid ) |
161 |
CALL WRITE_LOCAL_RL( 'ice_sOceMxL', 'I10', 1, |
162 |
& sOceMxL(1-Olx,1-Oly,bi,bj), |
163 |
& bi, bj, 1, myIter, myThid ) |
164 |
#ifndef LOCBIN_IO_THREAD_SAFE |
165 |
ENDIF |
166 |
#endif |
167 |
ENDIF |
168 |
ELSE |
169 |
C-- Use ocean mixed layer Temp as Atmos. SST (instead of prescribed Temp) |
170 |
DO j=1,sNy |
171 |
DO i=1,sNx |
172 |
IF ( land_frc(i,j,bi,bj) .LT. 1. _d 0 ) THEN |
173 |
aimTsoce(i,j) = tOceMxL(i,j,bi,bj)+celsius2K |
174 |
ENDIF |
175 |
ENDDO |
176 |
ENDDO |
177 |
ENDIF |
178 |
|
179 |
#endif /* ALLOW_THSICE */ |
180 |
#endif /* ALLOW_AIM */ |
181 |
|
182 |
RETURN |
183 |
END |