/[MITgcm]/MITgcm/pkg/aim_v23/aim_sice2aim.F
ViewVC logotype

Contents of /MITgcm/pkg/aim_v23/aim_sice2aim.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.11 - (show annotations) (download)
Sun Aug 27 21:46:52 2006 UTC (17 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58u_post, checkpoint58w_post, checkpoint60, checkpoint61, checkpoint58r_post, checkpoint58x_post, checkpoint58t_post, checkpoint58q_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint59, checkpoint58o_post, checkpoint58y_post, checkpoint58v_post, checkpoint58s_post, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint58p_post, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i
Changes since 1.10: +2 -1 lines
changed to pass when compiled with "ifort -check all"

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

  ViewVC Help
Powered by ViewVC 1.1.22