-
Notifications
You must be signed in to change notification settings - Fork 1
/
trcrst_pisces.F90
236 lines (215 loc) · 10.7 KB
/
trcrst_pisces.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
MODULE trcrst_pisces
!!======================================================================
!! *** MODULE trcrst_pisces ***
!! TOP : create, write, read the restart files of PISCES tracer
!!======================================================================
!! History : 1.0 ! 2010-01 (C. Ethe) Original
!!----------------------------------------------------------------------
#if defined key_pisces
!!----------------------------------------------------------------------
!! 'key_pisces' pisces tracers
!!----------------------------------------------------------------------
!! trc_rst_read_pisces : read restart file
!! trc_rst_wri_pisces : write restart file
!!----------------------------------------------------------------------
USE oce_trc ! Ocean variables
USE par_trc ! TOP parameters
USE trc ! TOP variables
USE trcsms_pisces ! pisces sms trends
USE sms_pisces ! pisces sms variables
USE iom
USE trcdta
IMPLICIT NONE
PRIVATE
PUBLIC trc_rst_read_pisces ! called by trcini.F90 module
PUBLIC trc_rst_wri_pisces ! called by trcini.F90 module
CONTAINS
SUBROUTINE trc_rst_read_pisces( knum )
!!----------------------------------------------------------------------
!! *** trc_rst_read_pisces ***
!!
!! ** Purpose : Read in restart file specific variables from pisces model
!!
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: knum ! unit of the restart file
INTEGER :: ji, jj, jk
REAL(wp) :: zcaralk, zbicarb, zco3
REAL(wp) :: ztmas, ztmas1
!!----------------------------------------------------------------------
!
IF( ln_trcdta .AND. ln_pisclo ) CALL pis_dmp_clo ! restoring of nutrients on close seas
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' trc_rst_read_pisces : Read specific variables from pisces model '
IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
!
IF( iom_varid( knum, 'PH', ldstop = .FALSE. ) > 0 ) THEN
CALL iom_get( knum, jpdom_autoglo, 'PH' , hi(:,:,:) )
ELSE
! hi(:,:,:) = 1.e-9
! Set PH from total alkalinity, borat (???), akb3 (???) and ak23 (???)
! --------------------------------------------------------
DO jk = 1, jpk
DO jj = 1, jpj
DO ji = 1, jpi
ztmas = tmask(ji,jj,jk)
ztmas1 = 1. - tmask(ji,jj,jk)
zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) )
zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk )
hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
END DO
END DO
END DO
ENDIF
CALL iom_get( knum, jpdom_autoglo, 'Silicalim', xksi(:,:) )
IF( iom_varid( knum, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
CALL iom_get( knum, jpdom_autoglo, 'Silicamax' , xksimax(:,:) )
ELSE
xksimax(:,:) = xksi(:,:)
ENDIF
END SUBROUTINE trc_rst_read_pisces
SUBROUTINE trc_rst_wri_pisces( kt, kitrst, knum )
!!----------------------------------------------------------------------
!! *** trc_rst_read_pisces ***
!!
!! ** Purpose : Read in restart file specific variables from pisces model
!!
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! time step
INTEGER, INTENT(in) :: kitrst ! time step of restart write
INTEGER, INTENT(in) :: knum ! unit of the restart file
!!----------------------------------------------------------------------
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' trc_rst_wri_pisces : Write specific variables from pisces model '
IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
CALL iom_rstput( kt, kitrst, knum, 'PH', hi(:,:,:) )
CALL iom_rstput( kt, kitrst, knum, 'Silicalim', xksi(:,:) )
CALL iom_rstput( kt, kitrst, knum, 'Silicamax', xksimax(:,:) )
END SUBROUTINE trc_rst_wri_pisces
SUBROUTINE pis_dmp_clo
!!---------------------------------------------------------------------
!! *** ROUTINE pis_dmp_clo ***
!!
!! ** Purpose : Closed sea domain initialization
!!
!! ** Method : if a closed sea is located only in a model grid point
!! we restore to initial data
!!
!! ** Action : ictsi1(), ictsj1() : south-west closed sea limits (i,j)
!! ictsi2(), ictsj2() : north-east Closed sea limits (i,j)
!!----------------------------------------------------------------------
INTEGER, PARAMETER :: npicts = 4 ! number of closed sea
INTEGER, DIMENSION(npicts) :: ictsi1, ictsj1 ! south-west closed sea limits (i,j)
INTEGER, DIMENSION(npicts) :: ictsi2, ictsj2 ! north-east closed sea limits (i,j)
INTEGER :: ji, jj, jk, jn, jl, jc ! dummy loop indices
INTEGER :: ierr ! local integer
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrcdta ! 4D workspace
!!----------------------------------------------------------------------
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*)' pis_dmp_clo : closed seas '
IF(lwp) WRITE(numout,*)'~~~~~~~'
! initial values
ictsi1(:) = 1 ; ictsi2(:) = 1
ictsj1(:) = 1 ; ictsj2(:) = 1
! set the closed seas (in data domain indices)
! -------------------
IF( cp_cfg == "orca" ) THEN
!
SELECT CASE ( jp_cfg )
! ! =======================
CASE ( 2 ) ! ORCA_R2 configuration
! ! =======================
! ! Caspian Sea
ictsi1(1) = 11 ; ictsj1(1) = 103
ictsi2(1) = 17 ; ictsj2(1) = 112
! ! Great North American Lakes
ictsi1(2) = 97 ; ictsj1(2) = 107
ictsi2(2) = 103 ; ictsj2(2) = 111
! ! Black Sea 1 : west part of the Black Sea
ictsi1(3) = 174 ; ictsj1(3) = 107
ictsi2(3) = 181 ; ictsj2(3) = 112
! ! Black Sea 2 : est part of the Black Sea
ictsi1(4) = 2 ; ictsj1(4) = 107
ictsi2(4) = 6 ; ictsj2(4) = 112
! ! =======================
CASE ( 4 ) ! ORCA_R4 configuration
! ! =======================
! ! Caspian Sea
ictsi1(1) = 4 ; ictsj1(1) = 53
ictsi2(1) = 4 ; ictsj2(1) = 56
! ! Great North American Lakes
ictsi1(2) = 49 ; ictsj1(2) = 55
ictsi2(2) = 51 ; ictsj2(2) = 56
! ! Black Sea
ictsi1(3) = 88 ; ictsj1(3) = 55
ictsi2(3) = 91 ; ictsj2(3) = 56
! ! Baltic Sea
ictsi1(4) = 75 ; ictsj1(4) = 59
ictsi2(4) = 76 ; ictsj2(4) = 61
! ! =======================
! ! =======================
CASE ( 025 ) ! ORCA_R025 configuration
! ! =======================
! Caspian + Aral sea
ictsi1(1) = 1330 ; ictsj1(1) = 645
ictsi2(1) = 1400 ; ictsj2(1) = 795
! ! Azov Sea
ictsi1(2) = 1284 ; ictsj1(2) = 722
ictsi2(2) = 1304 ; ictsj2(2) = 747
!
END SELECT
!
ENDIF
! convert the position in local domain indices
! --------------------------------------------
DO jc = 1, npicts
ictsi1(jc) = mi0( ictsi1(jc) )
ictsj1(jc) = mj0( ictsj1(jc) )
ictsi2(jc) = mi1( ictsi2(jc) )
ictsj2(jc) = mj1( ictsj2(jc) )
END DO
! Restore close seas values to initial data
IF( nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping
ALLOCATE( ztrcdta(jpi,jpj,jpk,nb_trcdta), STAT=ierr )
IF( ierr > 0 ) THEN
CALL ctl_stop( 'trc_ini: unable to allocate ztrcdta array' ) ; RETURN
ENDIF
!
CALL trc_dta( nittrc000, ztrcdta ) ! read tracer data at nittrc000
!
DO jn = 1, jptra
IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
jl = n_trc_index(jn)
DO jc = 1, npicts
DO jk = 1, jpkm1
DO jj = ictsj1(jc), ictsj2(jc)
DO ji = ictsi1(jc), ictsi2(jc)
trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk)
trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
ENDDO
DEALLOCATE( ztrcdta )
ENDIF
!
END SUBROUTINE pis_dmp_clo
#else
!!----------------------------------------------------------------------
!! Dummy module : No passive tracer
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE trc_rst_read_pisces( knum )
INTEGER, INTENT(in) :: knum
WRITE(*,*) 'trc_rst_read_pisces: You should not have seen this print! error?', knum
END SUBROUTINE trc_rst_read_pisces
SUBROUTINE trc_rst_wri_pisces( kt, kitrst, knum )
INTEGER, INTENT(in) :: kt, kitrst, knum
WRITE(*,*) 'trc_rst_wri_pisces: You should not have seen this print! error?', kt, kitrst, knum
END SUBROUTINE trc_rst_wri_pisces
#endif
!!======================================================================
END MODULE trcrst_pisces