-
Notifications
You must be signed in to change notification settings - Fork 26
/
Copy pathmod_tracers_update.F90
537 lines (461 loc) · 17.8 KB
/
mod_tracers_update.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
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
! ------------------------------------------------------------------------------
! Copyright (C) 2007-2024 Mats Bentsen, Jörg Schwinger, Jerry Tjiputra,
! Alok Kumar Gupta, Mariana Vertenstein
!
! This file is part of BLOM.
!
! BLOM is free software: you can redistribute it and/or modify it under the
! terms of the GNU Lesser General Public License as published by the Free
! Software Foundation, either version 3 of the License, or (at your option)
! any later version.
!
! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY
! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
! more details.
!
! You should have received a copy of the GNU Lesser General Public License
! along with BLOM. If not, see <https://www.gnu.org/licenses/>.
! ------------------------------------------------------------------------------
module mod_tracers_update
use mod_types, only: r8
use mod_grid, only: plon, plat
use mod_tracers, only: ntrocn, natr, ntr, trc
use mod_idlage, only: idlage_init
use mod_idlage, only: idlage_step
#ifdef HAMOCC
use mo_param1_bgc, only: init_indices, nocetra
use mo_hamocc_init, only: hamocc_init
use mo_hamocc_step, only: hamocc_step
use mo_restart_hamoccwt, only: restart_hamoccwt
#endif
use mod_constants, only: spval
use mod_calendar, only: date_type, operator(/=)
use mod_time, only: date0, time0, time
use mod_dia, only: iotype, rstfmt, rstcmp
use mod_config, only: expcnf
use mod_ifdefs, only: use_ATRC, use_IDLAGE
use mod_nctools
use mod_xc
implicit none
private
! Public routines
public :: initrc
public :: updtrc
public :: restart_trcwt
public :: restart_trcrd
! Private routines
private :: restart_ocntrcwt
private :: restart_ocntrcrd
private :: restart_getfile
contains
subroutine initrc()
! ------------------------------------------------------------------
! initialization of ocean tracers
! ------------------------------------------------------------------
integer :: i,j,k,l,nt,nat
! ------------------------------------------------------------------
! if no ocean tracers are defined
! ------------------------------------------------------------------
if (ntrocn /= 0) then
! ------------------------------------------------------------------
! if number of age tracers is greater than zero, CPP flag ATRC must
! be defined
! ------------------------------------------------------------------
if (.not. use_ATRC) then
if (natr > 0) then
if (mnproc == 1) then
write (lp,'(2a)') ' Since number of age tracers is greater ', &
'than zero, ATRC must be defined!'
end if
call xcstop('(ocntrc_init)')
stop '(ocntrc_init)'
end if
end if
! ------------------------------------------------------------------
! check number of age tracers
! ------------------------------------------------------------------
if (natr < 0.or.2*natr > ntrocn) then
if (mnproc == 1) then
write (lp,'(3a)') ' Number of age tracers must be greater ', &
'than zero and less or equal half the total number of ', &
'ocean tracers!'
end if
call xcstop('(ocntrc_init)')
stop '(ocntrc_init)'
end if
! ------------------------------------------------------------------
! initialization of tracers
! ------------------------------------------------------------------
do nt = 1,ntrocn-natr
!$omp parallel do private(k,l,i)
do j = 1,jj
do k = 1,kk
do l = 1,isp(j)
do i = max(1,ifp(j,l)),min(ii,ilp(j,l))
trc(i,j,k,nt)= &
(mod(k,5)+1)*(plat(i,j)+90._r8)/(5._r8*180._r8)+nt
trc(i,j,k+kk,nt) = trc(i,j,k,nt)
end do
end do
end do
end do
!$omp end parallel do
end do
! ------------------------------------------------------------------
! initialization of age tracers
! ------------------------------------------------------------------
do nt = 1,natr
nat = ntr-natr+nt
!$omp parallel do private(k,l,i)
do j = 1,jj
do k = 1,kk
do l = 1,isp(j)
do i = max(1,ifp(j,l)),min(ii,ilp(j,l))
trc(i,j,k,nat)= &
(mod(k,5)*(plon(i,j)+180._r8)/(4._r8*360._r8)+nat) &
*trc(i,j,k,nt)
trc(i,j,k+kk,nat) = trc(i,j,k,nat)
end do
end do
end do
end do
!$omp end parallel do
end do
end if ! if (ntrocn != 0)
#ifdef HAMOCC
call hamocc_init(0,'c')
#endif
if (use_IDLAGE) then
call idlage_init
end if
end subroutine initrc
! ============================================================================
subroutine updtrc(m,n,mm,nn,k1m,k1n)
! ------------------------------------------------------------------
! update tracers due to non-passive processes
! ------------------------------------------------------------------
integer, intent(in) :: m,n,mm,nn,k1m,k1n
#ifdef HAMOCC
call hamocc_step(m,n,mm,nn,k1m,k1n)
#endif
if (use_IDLAGE) then
call idlage_step(m,n,mm,nn,k1m,k1n)
end if
end subroutine updtrc
! ============================================================================
subroutine restart_trcwt(rstfnm_ocn)
! ------------------------------------------------------------------
! Write tracer state to restart files
! ------------------------------------------------------------------
! Arguments
character(len=*), intent(in) :: rstfnm_ocn
! Local variables
logical :: error
character(len=256) :: rstfnm_ocntrc
character(len=256) :: rstfnm_hamocc
! ------------------------------------------------------------------
! Generate file name
! ------------------------------------------------------------------
if (mnproc == 1) then
if (expcnf == 'cesm') then
call restart_getfile(rstfnm_ocn, 'rtrc', rstfnm_ocntrc, error)
if (error) then
write(lp,*) 'restart_trcwt: could not generate rstfnm_ocntrc file!'
call xcstop('(restat_trcwt)')
stop '(restart_trcwt)'
endif
call restart_getfile(rstfnm_ocn, 'rbgc', rstfnm_hamocc, error)
if (error) then
write(lp,*) 'restart_trcwt: could not generate rstfnm_hamocc file!'
call xcstop('(restat_trcwt)')
stop '(restart_trcwt)'
endif
else
call restart_getfile(rstfnm_ocn, 'resttrc', rstfnm_ocntrc, error)
if (error) then
write(lp,*) 'restart_trcwt: could not generate rstfnm_ocntrc file!'
call xcstop('(restat_trcwt)')
stop '(restart_trcwt)'
endif
call restart_getfile(rstfnm_ocn, 'restbgc', rstfnm_hamocc, error)
if (error) then
write(lp,*) 'restart_trcwt: could not generate rstfnm_hamocc file!'
call xcstop('(restat_trcwt)')
stop '(restart_trcwt)'
endif
endif
endif
call xcbcst(rstfnm_ocntrc)
call xcbcst(rstfnm_hamocc)
! ------------------------------------------------------------------
! Write restart files
! ------------------------------------------------------------------
!
call restart_ocntrcwt(rstfnm_ocntrc)
#ifdef HAMOCC
call restart_hamoccwt(rstfnm_hamocc)
#endif
end subroutine restart_trcwt
! ============================================================================
subroutine restart_trcrd(rstfnm_ocn)
! ------------------------------------------------------------------
! Read tracer state from restart files
! ------------------------------------------------------------------
! Arguments
character(len=*), intent(in) :: rstfnm_ocn
! Local variables
logical :: error
character(len=256) :: rstfnm_ocntrc
character(len=256) :: rstfnm_hamocc
! ------------------------------------------------------------------
! Generate file name
! ------------------------------------------------------------------
if (mnproc == 1) then
if (expcnf == 'cesm') then
call restart_getfile(rstfnm_ocn, 'rtrc', rstfnm_ocntrc, error)
if (error) then
write(lp,*) 'restart_trcrd: could not generate rstfnm_ocntrc file!'
call xcstop('(restat_trcrd)')
stop '(restart_trcrd)'
endif
call restart_getfile(rstfnm_ocn, 'rbgc', rstfnm_hamocc, error)
if (error) then
write(lp,*) 'restart_trcrd: could not generate rstfnm_hamocc file!'
call xcstop('(restat_trcrd)')
stop '(restart_trcrd)'
endif
else
call restart_getfile(rstfnm_ocn, 'resttrc', rstfnm_ocntrc, error)
if (error) then
write(lp,*) 'restart_trcrd: could not generate rstfnm_ocntrc file!'
call xcstop('(restat_trcrd)')
stop '(restart_trcrd)'
endif
call restart_getfile(rstfnm_ocn, 'restbgc', rstfnm_hamocc, error)
if (error) then
write(lp,*) 'restart_trcrd: could not generate rstfnm_hamocc file!'
call xcstop('(restat_trcrd)')
stop '(restart_trcrd)'
endif
endif
endif
call xcbcst(rstfnm_ocntrc)
call xcbcst(rstfnm_hamocc)
! ------------------------------------------------------------------
! Read restart files
! ------------------------------------------------------------------
call restart_ocntrcrd(rstfnm_ocntrc)
#ifdef HAMOCC
call hamocc_init(1,rstfnm_hamocc)
#endif
end subroutine restart_trcrd
! ============================================================================
subroutine restart_ocntrcwt(rstfnm)
! ------------------------------------------------------------------
! Write ocean tracer state to restart file
! ------------------------------------------------------------------
! Arguments
character :: rstfnm*(*)
! Local variables
integer :: nt,nat
character(len = 256) :: trcnm
! ------------------------------------------------------------------
! if no ocean tracers are defined, return
! ------------------------------------------------------------------
if (ntrocn == 0) return
! ------------------------------------------------------------------
! Create file
! ------------------------------------------------------------------
if (mnproc == 1) then
write (lp,'(2a)') ' saving ocean tracer restart file ', &
trim(rstfnm)
end if
if (rstfmt == 1) then
call ncfopn(rstfnm,'w','6',1,iotype)
else if (rstfmt == 2) then
call ncfopn(rstfnm,'w','h',1,iotype)
else
call ncfopn(rstfnm,'w','c',1,iotype)
end if
! ------------------------------------------------------------------
! Create attributes and dimensions
! ------------------------------------------------------------------
call ncputi('nday0',date0%day)
call ncputi('nmonth0',date0%month)
call ncputi('nyear0',date0%year)
call ncputr('time0',time0)
call ncputr('time',time)
if (rstcmp == 1) then
call ncdimc('pcomp',ip,0)
else
call ncdims('x',itdm)
call ncdims('y',jtdm)
end if
call ncdims('kk2',2*kk)
call ncdims('time',1)
! ------------------------------------------------------------------
! Write tracer data to file
! ------------------------------------------------------------------
do nt = 1,ntrocn-natr
write (trcnm,'(a,i3.3)') 'trc',nt
if (rstcmp == 1) then
call ncdefvar(trim(trcnm),'pcomp kk2 time', &
ndouble,8)
else
call ncdefvar(trim(trcnm),'x y kk2 time', &
ndouble,8)
end if
end do
do nt = 1,natr
nat = ntr-natr+nt
write (trcnm,'(a,i3.3)') 'atrc',nt
if (rstcmp == 1) then
call ncdefvar(trim(trcnm),'pcomp kk2 time', &
ndouble,8)
else
call ncdefvar(trim(trcnm),'x y kk2 time', &
ndouble,8)
end if
end do
call ncedef
do nt = 1,ntrocn-natr
write (trcnm,'(a,i3.3)') 'trc',nt
if (rstcmp == 1) then
call nccomp(trim(trcnm),'pcomp kk2 time', &
trc(1-nbdy,1-nbdy,1,nt),ip,1.,0.,8)
else
call ncwrtr(trim(trcnm),'x y kk2 time', &
trc(1-nbdy,1-nbdy,1,nt),ip,1,1.,0.,8)
end if
end do
do nt = 1,natr
nat = ntr-natr+nt
write (trcnm,'(a,i3.3)') 'atrc',nt
if (rstcmp == 1) then
call nccomp(trim(trcnm),'pcomp kk2 time', &
trc(1-nbdy,1-nbdy,1,nat),ip,1.,0.,8)
else
call ncwrtr(trim(trcnm),'x y kk2 time', &
trc(1-nbdy,1-nbdy,1,nat),ip,1,1.,0.,8)
end if
end do
call ncfcls
end subroutine restart_ocntrcwt
! ============================================================================
subroutine restart_ocntrcrd(rstfnm)
! ------------------------------------------------------------------
! Read ocean tracer state from restart file
! ------------------------------------------------------------------
! Arguments
character :: rstfnm*(*)
! Local variables
type(date_type) :: date_rest
integer :: nt,nat
real :: time0r,timer
logical :: fexist
character(len = 256) :: trcnm
! ------------------------------------------------------------------
! If no ocean tracers are defined, return
! ------------------------------------------------------------------
if (ntrocn == 0) return
! ------------------------------------------------------------------
! Check for file existence
! ------------------------------------------------------------------
inquire(file=rstfnm,exist = fexist)
call xcbcst(fexist)
! ------------------------------------------------------------------
! If file exists, read tracer data from file
! ------------------------------------------------------------------
if (.not.fexist) then
if (mnproc == 1) then
write (lp,*) &
'Warning! No tracer restart file found. Calling ocntrc_init...'
end if
call initrc
else
if (mnproc == 1) then
write (lp,'(2a)') ' reading ocean tracer restart file ', &
trim(rstfnm)
end if
call ncfopn(rstfnm,'r',' ',1,iotype)
call ncgeti('nday0',date_rest%day)
call ncgeti('nmonth0',date_rest%month)
call ncgeti('nyear0',date_rest%year)
call ncgetr('time0',time0r)
call ncgetr('time',timer)
if (mnproc == 1) then
if (date_rest /= date0 .or. &
time0r /= time0 .or. timer /= time) then
write (lp,'(2a)') &
' Warning! The time information of the model and', &
' restart file is inconsistent'
write (lp,'(a)') ' model file'
write (lp,'(a,i4.4,2(i2.2),a,i4.4,2(i2.2))') &
' date0: ',date0, ' ',date_rest
write (lp,'(a,2f14.4)') &
' time0: ',time0,time0r
write (lp,'(a,2f14.4)') &
' time: ',time,timer
end if
end if
do nt = 1,ntrocn-natr
write (trcnm,'(a,i3.3)') 'trc',nt
call ncread(trim(trcnm),trc(1-nbdy,1-nbdy,1,nt),ip,1,0.)
end do
do nt = 1,natr
nat = ntr-natr+nt
write (trcnm,'(a,i3.3)') 'atrc',nt
call ncread(trim(trcnm),trc(1-nbdy,1-nbdy,1,nat),ip,1,0.)
end do
call ncfcls
end if
end subroutine restart_ocntrcrd
! ============================================================================
subroutine restart_getfile(rstfnm_in, rstlabel, rstfnm_out, rstfnm_err)
! ------------------------------------------------------------------
! Generate filename for restart files to read or write tracer fields
! ------------------------------------------------------------------
! Argument
character(len=*), intent(in) :: rstfnm_in ! Original restart file name
character(len=*), intent(in) :: rstlabel ! Label to insert in new file
character(len=*), intent(out) :: rstfnm_out ! New restart file name
logical, intent(out) :: rstfnm_err ! Error flag
! Local variables
integer :: i_suffix, i_time, i_restart
character(len=:), allocatable :: str_suffix, str_time, str_restart
rstfnm_err = .false.
if (expcnf.eq.'cesm') then
! Assume file format: <str_restart.>'r'<.str_timestamp><.str_suffix>
! Search for '.' starting from end of "rstfnm_in" filename
! File suffix
i_suffix = index(rstfnm_in, '.', back=.true.)
str_suffix = trim(rstfnm_in(i_suffix:))
! File timestamp
i_time = index(rstfnm_in(:(i_suffix-1)), '.', back=.true.)
str_time = rstfnm_in(i_time:(i_suffix-1))
! File without original restart label
i_restart = index(rstfnm_in(:(i_time-1)), '.', back=.true.)
str_restart = rstfnm_in(:i_restart)
if (i_suffix == 0 .or. i_time == 0 .or. i_restart == 0) then
rstfnm_err = .true.
else
rstfnm_out = str_restart // trim(rstlabel) // str_time // str_suffix
end if
else
! Assume file format: <str_restart_>'restphy'<_str_suffix>
! Search for '_' starting from end of "rstfnm_in" filename
! File suffix
i_suffix = index(rstfnm_in, '_', back=.true.)
str_suffix = trim(rstfnm_in(i_suffix:))
! File without original restart label
i_restart = index(rstfnm_in(:(i_suffix-1)), '_', back=.true.)
str_restart = rstfnm_in(:i_restart)
if (i_suffix == 0 .or. i_restart == 0) then
rstfnm_err = .true.
else
rstfnm_out = str_restart // trim(rstlabel) // str_suffix
end if
end if
end subroutine restart_getfile
end module mod_tracers_update