*IF DEF,SEAICE INITOI1A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.15099
C GTS2F400.15100
C Use, duplication or disclosure of this code is subject to the GTS2F400.15101
C restrictions as set forth in the contract. GTS2F400.15102
C GTS2F400.15103
C Meteorological Office GTS2F400.15104
C London Road GTS2F400.15105
C BRACKNELL GTS2F400.15106
C Berkshire UK GTS2F400.15107
C RG12 2SZ GTS2F400.15108
C GTS2F400.15109
C If no contract has been raised with this copy of the code, the use, GTS2F400.15110
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.15111
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.15112
C Modelling at the above address. GTS2F400.15113
C ******************************COPYRIGHT****************************** GTS2F400.15114
C GTS2F400.15115
!+ Initialises variables from OCN_CTL used in OCEAN-ICE coupling. INITOI1A.3
! INITOI1A.4
! Subroutine Interface: INITOI1A.5
SUBROUTINE Init_Ocean_Ice ( 1,1ORH7F402.83
*CALL ARGOINDX
ORH7F402.84
& imt,itt,jmt,jmtm1 ORH7F402.85
&,amx,fkmp,heatflux,snowrate INITOI1A.7
&,wsx,wsy INITOI1A.8
&,icy,iceheatflux,oceanheatflux,icesnowrate,oceansnowrate INITOI1A.9
&,wsx_ice,wsx_leads,wsy_ice,wsy_leads INITOI1A.10
&,aice,newice ) INITOI1A.11
INITOI1A.12
IMPLICIT NONE INITOI1A.13
! INITOI1A.14
! Description: INITOI1A.15
! Initialises arrays used by ice model or ice-ocean coupling. INITOI1A.16
! On timestep 1 resets ice concentrations greater then the maximum INITOI1A.17
! and set ice concentration over land to zero. INITOI1A.18
! INITOI1A.19
! Method: INITOI1A.20
! <Say how it does it: include references to external documentation> INITOI1A.21
! <If this routine is very complex, then include a "pseudo code" INITOI1A.22
! description of it to make its structure and method clear> INITOI1A.23
! INITOI1A.24
! Current Code Owner: J.F.Crossley INITOI1A.25
! INITOI1A.26
! History: INITOI1A.27
! Version Date Comment INITOI1A.28
! ------- ---- ------- INITOI1A.29
! 4.0 4/05/95 Original code. J.F.Crossley INITOI1A.30
! 4.5 10/08/97 Changes to dynamic ice control logicals ODC1F405.342
! Chris Sherlock and Doug Cresswell ODC1F405.343
! INITOI1A.31
! Code Description: INITOI1A.32
! Language: FORTRAN 77 + common extensions. INITOI1A.33
! This code is written to UMDP3 v6 programming standards. INITOI1A.34
! INITOI1A.35
! System component covered: ?? INITOI1A.36
! System Task: ?? INITOI1A.37
! INITOI1A.38
! Declarations: INITOI1A.39
! These are of the form:- INITOI1A.40
! INTEGER ExampleVariable !Description of variable INITOI1A.41
! INITOI1A.42
! Global variables (*CALLed COMDECKs etc...): INITOI1A.43
*CALL UMSCALAR
INITOI1A.44
*CALL CNTLOCN
INITOI1A.45
*CALL OARRYSIZ
INITOI1A.46
*CALL TYPOINDX
ORH7F402.86
INITOI1A.47
! Subroutine arguments INITOI1A.48
! Scalar arguments with intent(in): INITOI1A.49
INTEGER imt !Number of columns on tracer grid INITOI1A.50
INTEGER itt !Timestep number INITOI1A.51
INTEGER jmt !Number of rows on tracer grid INITOI1A.52
INTEGER jmtm1 !Number of rows on tracer grid minus 1 INITOI1A.53
INITOI1A.54
! Array arguments with intent(in): INITOI1A.55
REAL amx(jmt) !Maximum ice concentration on each row. INITOI1A.56
REAL fkmp(imt,jmt) !Number of levels (land=0.0) INITOI1A.57
REAL wsx(imt_idr,jmtm1_idr) !Zonal wind stress ODC1F405.344
REAL wsy(imt_idr,jmtm1_idr) !Meridional wind stress ODC1F405.345
REAL heatflux(imt,jmt)!Net non-penetrative heat flux W/m2 INITOI1A.60
REAL snowrate(imt,jmt)!Snowfall rate kg/m2/s INITOI1A.61
INITOI1A.62
! Scalar arguments with intent(InOut): INITOI1A.63
INITOI1A.64
! Array arguments with intent(InOut): INITOI1A.65
LOGICAL newice(imt,jmt) !False on exit. INITOI1A.66
REAL aice(imt,jmt) !Ice concentration. INITOI1A.67
INITOI1A.68
! Scalar arguments with intent(out): INITOI1A.69
INITOI1A.70
! Array arguments with intent(out): INITOI1A.71
LOGICAL icy(imt,jmt) !True for ice conc. > min INITOI1A.72
REAL oceanheatflux(imt,jmt) !Heatflux*initial leads fraction INITOI1A.73
REAL oceansnowrate(imt,jmt) !Snowrate for initial open sea INITOI1A.74
REAL iceheatflux(imt,jmt) !Heatflux*initial ice fraction INITOI1A.75
REAL icesnowrate(imt,jmt) !Snowrate for initial seaice points INITOI1A.76
! The following arrays are only used with the cavitating fluid INITOI1A.77
! dynamic sea ice model. INITOI1A.78
REAL wsx_ice(imt_idr,jmtm1_idr) !Zonal stres into ice dynamics ODC1F405.346
REAL wsy_ice(imt_idr,jmtm1_idr) !Similar for meridional ODC1F405.347
REAL wsx_leads(imt_idr,jmtm1_idr)!Zonal stress into ocean ODC1F405.348
REAL wsy_leads(imt_idr,jmtm1_idr)!Similar for meridional ODC1F405.349
INITOI1A.83
! Local parameters: INITOI1A.84
INITOI1A.85
! Local scalars: INITOI1A.86
INTEGER i,j !Loop counters INITOI1A.87
REAL test_aice !Check on aice to determine ICY. INITOI1A.88
INITOI1A.89
! Local dynamic arrays: INITOI1A.90
REAL aice_uv(imt_idr,jmtm1_idr) !Aice on velocity grid ODC1F405.350
INITOI1A.92
! Function & Subroutine calls: INITOI1A.93
External H_TO_UV INITOI1A.94
INITOI1A.95
!- End of header INITOI1A.96
! -------------------------------------------------------- INITOI1A.97
! Trap areal fractions greater than the specified maxima. INITOI1A.98
! For models without a polar island, ice fraction is zeroed at all INITOI1A.99
! land points. For those with a polar island row jmt (the polar row) INITOI1A.100
! is omitted and all other land points are zeroed. INITOI1A.101
! This should be an initialisation function only. INITOI1A.102
if (itt.eq.1) then INITOI1A.103
if (.not.l_onopolo) then INITOI1A.104
do j = J_1,J_jmt ORH3F402.377
do i = 1,imt INITOI1A.106
if ( aice(i,j) .gt. amx(j) ) then INITOI1A.107
aice(i,j) = amx(j) INITOI1A.108
endif INITOI1A.109
if (j+J_OFFSET.lt.jmt_GLOBAL .and. fkmp(i,j).lt.0.5) then ORH3F402.378
aice(i,j)=0. INITOI1A.111
endif INITOI1A.112
end do INITOI1A.113
end do INITOI1A.114
else INITOI1A.115
do j = J_1,J_jmt ORH3F402.379
do i = 1,imt INITOI1A.117
if ( aice(i,j) .gt. amx(j) ) then INITOI1A.118
aice(i,j) = amx(j) INITOI1A.119
endif INITOI1A.120
if (fkmp(i,j).lt..5) then INITOI1A.121
aice(i,j)=0. INITOI1A.122
endif INITOI1A.123
end do INITOI1A.124
end do INITOI1A.125
endif ! l_onopolo INITOI1A.126
endif ! itt=1 INITOI1A.127
! --------------------------------------------------------- INITOI1A.128
! Set up logical variable ICY for ROW_CTL and ICE_CTL INITOI1A.129
! TRUE if ice present, FALSE otherwise. INITOI1A.130
! Also initialise logical variable NEWICE to FALSE everywhere. INITOI1A.131
INITOI1A.132
! Note: The following code initialises ICY in all halo regions ORH5F403.311
! by running over J = 1, JMT rather than J = J_1 to J_JMT. ORH5F403.312
! This is needed because ICY is used as a mask in STASH ORH5F403.313
! processing and ALL points must be initialised including ORH5F403.314
! halo rows which do not refer to ocean points ie: halos ORH5F403.315
! of the 1st pe and last pe. ORH5F403.316
DO J = 1, JMT ORH5F403.317
DO I = 1, IMT ORH5F403.318
ICY(I,J) = .FALSE. ORH5F403.319
ENDDO ORH5F403.320
ENDDO ORH5F403.321
test_aice=aicemin*0.1 INITOI1A.133
do j=J_1,J_jmt ORH3F402.380
do i=1,imt INITOI1A.135
if (l_onopolo) then INITOI1A.136
icy(i,j)=( aice(i,j).gt.test_aice .and. (fkmp(i,j).gt.0.1)) INITOI1A.137
else INITOI1A.138
icy(i,j)=( aice(i,j).gt.test_aice .and. INITOI1A.139
& (fkmp(i,j).gt.0.1.or.j+J_OFFSET.eq.jmt_GLOBAL)) ORH3F402.381
endif ! l_onopolo INITOI1A.141
newice(i,j) = .false. INITOI1A.142
end do INITOI1A.143
end do INITOI1A.144
! --------------------------------------------------------- INITOI1A.145
! Section to calculate ice and leads wind stresses for cav fluid INITOI1A.146
! ice dynamics model by weighting grid box mean values by the INITOI1A.147
! ice fraction interpolated to the UV grid. INITOI1A.148
if (l_icefreedr) then ODC1F405.351
call h_to_uv
( ORH7F402.87
*CALL ARGOINDX
ORH7F402.88
& aice,aice_uv,imt,jmt,jmtm1) ORH7F402.89
do j=J_1,J_jmtm1 ORH3F402.382
do i=1,imt INITOI1A.152
if (aice_uv(i,j).gt.0.0005) then INITOI1A.153
wsx_ice(i,j) = wsx(i,j) * aice_uv(i,j) INITOI1A.154
wsy_ice(i,j) = wsy(i,j) * aice_uv(i,j) INITOI1A.155
wsx_leads(i,j) = wsx(i,j) * (1.0-aice_uv(i,j)) INITOI1A.156
wsy_leads(i,j) = wsy(i,j) * (1.0-aice_uv(i,j)) INITOI1A.157
else INITOI1A.158
wsx_ice(i,j) = 0.0 INITOI1A.159
wsy_ice(i,j) = 0.0 INITOI1A.160
wsx_leads(i,j) = wsx(i,j) INITOI1A.161
wsy_leads(i,j) = wsy(i,j) INITOI1A.162
endif INITOI1A.163
end do INITOI1A.164
end do INITOI1A.165
endif ! l_icefreedr ODC1F405.352
! --------------------------------------------------------- INITOI1A.167
! Initialise OCEANSNOWRATE and ICESNOWRATE INITOI1A.168
do j=J_1,J_jmt ORH3F402.383
do i=1,imt INITOI1A.170
if (icy(i,j)) then INITOI1A.171
oceansnowrate(i,j) = 0.0 INITOI1A.172
icesnowrate(i,j) = snowrate(i,j) INITOI1A.173
else INITOI1A.174
oceansnowrate(i,j) = snowrate(i,j) INITOI1A.175
icesnowrate(i,j) = 0.0 INITOI1A.176
endif INITOI1A.177
end do INITOI1A.178
end do INITOI1A.179
! --------------------------------------------------------- INITOI1A.180
! Initialise OCEANHEATFLUX and ICEHEATFLUX INITOI1A.181
! For ice models including dynamics :- INITOI1A.182
! Weight HEATFLUX by ice fraction to give ICEHEATFLUX and by leads INITOI1A.183
! fraction to give OCEANHEATFLUX. Done here to ensure that the same INITOI1A.184
! ice fraction is used for both ice and ocean and hence energy is INITOI1A.185
! conserved in the split. INITOI1A.186
! For thermodynamic ice models :- INITOI1A.187
! Oceanheatflux is set to zero at ice points and the full value INITOI1A.188
! elsewhere. INITOI1A.189
! Iceheatflux is set to zero at open ocean points and the full value INITOI1A.190
! elsewhere. INITOI1A.191
! For ocean models which do not use coupled forcing for the ice INITOI1A.192
! model, iceheatflux is calculated in suroutine PSEUDAIR and INITOI1A.193
! oceanheatflux is weighted below. INITOI1A.194
if (l_oicecoup) then INITOI1A.195
do j=J_1,J_jmt ORH3F402.384
do i=1,imt INITOI1A.197
if (icy(i,j)) then INITOI1A.198
if (l_icefreedr .or. l_icesimple) then ODC1F405.353
oceanheatflux(i,j) = heatflux(i,j) * (1.0-aice(i,j)) INITOI1A.200
iceheatflux(i,j) = heatflux(i,j) * aice(i,j) INITOI1A.201
else INITOI1A.202
oceanheatflux(i,j) = 0.0 INITOI1A.203
iceheatflux(i,j) = heatflux(i,j) INITOI1A.204
endif ! l_icefreedr or l_icesimple ODC1F405.354
else INITOI1A.206
oceanheatflux(i,j) = heatflux(i,j) INITOI1A.207
iceheatflux(i,j) = 0.0 INITOI1A.208
endif INITOI1A.209
end do INITOI1A.210
end do INITOI1A.211
else ! l_oicecoup INITOI1A.212
do j=J_1,J_jmt ORH3F402.385
do i=1,imt INITOI1A.214
if (icy(i,j)) then INITOI1A.215
if (l_icefreedr .or. l_icesimple) then ODC1F405.355
oceanheatflux(i,j) = heatflux(i,j) * (1.0-aice(i,j)) INITOI1A.217
& * (1.0-aice(i,j)) INITOI1A.218
else INITOI1A.219
oceanheatflux(i,j) = 0.0 INITOI1A.220
endif ! l_icefreedr or l_icesimple ODC1F405.356
iceheatflux(i,j) = 0.0 INITOI1A.222
else INITOI1A.223
oceanheatflux(i,j) = heatflux(i,j) INITOI1A.224
iceheatflux(i,j) = 0.0 INITOI1A.225
endif INITOI1A.226
end do INITOI1A.227
end do INITOI1A.228
endif ! l_oicecoup INITOI1A.229
Return INITOI1A.230
End INITOI1A.231
*ENDIF INITOI1A.232