-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathdomzgr.F90
More file actions
2734 lines (2568 loc) · 135 KB
/
domzgr.F90
File metadata and controls
2734 lines (2568 loc) · 135 KB
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
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
MODULE domzgr
!!==============================================================================
!! *** MODULE domzgr ***
!! Ocean initialization : domain initialization
!!==============================================================================
!! History : OPA ! 1995-12 (G. Madec) Original code : s vertical coordinate
!! ! 1997-07 (G. Madec) lbc_lnk call
!! ! 1997-04 (J.-O. Beismann)
!! 8.5 ! 2002-09 (A. Bozec, G. Madec) F90: Free form and module
!! - ! 2002-09 (A. de Miranda) rigid-lid + islands
!! NEMO 1.0 ! 2003-08 (G. Madec) F90: Free form and module
!! - ! 2005-10 (A. Beckmann) modifications for hybrid s-ccordinates & new stretching function
!! 2.0 ! 2006-04 (R. Benshila, G. Madec) add zgr_zco
!! 3.0 ! 2008-06 (G. Madec) insertion of domzgr_zps.h90 & conding style
!! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option
!! 3.3 ! 2010-11 (G. Madec) add mbk. arrays associated to the deepest ocean level
!! 3.4 ! 2012-08 (J. Siddorn) added Siddorn and Furner stretching function
!! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) modify C1D case
!! 3.6 ! 2014-11 (P. Mathiot and C. Harris) add ice shelf capabilitye
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! dom_zgr : defined the ocean vertical coordinate system
!! zgr_bat : bathymetry fields (levels and meters)
!! zgr_bat_zoom : modify the bathymetry field if zoom domain
!! zgr_bat_ctl : check the bathymetry files
!! zgr_bot_level: deepest ocean level for t-, u, and v-points
!! zgr_z : reference z-coordinate
!! zgr_zco : z-coordinate
!! zgr_zps : z-coordinate with partial steps
!! zgr_sco : s-coordinate
!! fssig : tanh stretch function
!! fssig1 : Song and Haidvogel 1994 stretch function
!! fgamma : Siddorn and Furner 2012 stretching function
!!---------------------------------------------------------------------
USE oce ! ocean variables
USE dom_oce ! ocean domain
USE closea ! closed seas
USE c1d ! 1D vertical configuration
USE in_out_manager ! I/O manager
USE iom ! I/O library
USE lbclnk ! ocean lateral boundary conditions (or mpp link)
USE lib_mpp ! distributed memory computing library
USE wrk_nemo ! Memory allocation
USE timing ! Timing
IMPLICIT NONE
PRIVATE
PUBLIC dom_zgr ! called by dom_init.F90
! !!* Namelist namzgr_sco *
LOGICAL :: ln_s_sh94 ! use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1 (ln_sco=T)
LOGICAL :: ln_s_sf12 ! use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma (ln_sco=T)
!
REAL(wp) :: rn_sbot_min ! minimum depth of s-bottom surface (>0) (m)
REAL(wp) :: rn_sbot_max ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
REAL(wp) :: rn_rmax ! maximum cut-off r-value allowed (0<rn_rmax<1)
REAL(wp) :: rn_hc ! Critical depth for transition from sigma to stretched coordinates
! Song and Haidvogel 1994 stretching parameters
REAL(wp) :: rn_theta ! surface control parameter (0<=rn_theta<=20)
REAL(wp) :: rn_thetb ! bottom control parameter (0<=rn_thetb<= 1)
REAL(wp) :: rn_bb ! stretching parameter
! ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
! Siddorn and Furner stretching parameters
LOGICAL :: ln_sigcrit ! use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
REAL(wp) :: rn_alpha ! control parameter ( > 1 stretch towards surface, < 1 towards seabed)
REAL(wp) :: rn_efold ! efold length scale for transition to stretched coord
REAL(wp) :: rn_zs ! depth of surface grid box
! bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
REAL(wp) :: rn_zb_a ! bathymetry scaling factor for calculating Zb
REAL(wp) :: rn_zb_b ! offset for calculating Zb
!! * Substitutions
# include "domzgr_substitute.h90"
# include "vectopt_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3.1 , NEMO Consortium (2011)
!! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE dom_zgr
!!----------------------------------------------------------------------
!! *** ROUTINE dom_zgr ***
!!
!! ** Purpose : set the depth of model levels and the resulting
!! vertical scale factors.
!!
!! ** Method : - reference 1D vertical coordinate (gdep._1d, e3._1d)
!! - read/set ocean depth and ocean levels (bathy, mbathy)
!! - vertical coordinate (gdep., e3.) depending on the
!! coordinate chosen :
!! ln_zco=T z-coordinate
!! ln_zps=T z-coordinate with partial steps
!! ln_zco=T s-coordinate
!!
!! ** Action : define gdep., e3., mbathy and bathy
!!----------------------------------------------------------------------
INTEGER :: ioptio, ibat ! local integer
INTEGER :: ios
!
NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('dom_zgr')
!
REWIND( numnam_ref ) ! Namelist namzgr in reference namelist : Vertical coordinate
READ ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
REWIND( numnam_cfg ) ! Namelist namzgr in configuration namelist : Vertical coordinate
READ ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
IF(lwm) WRITE ( numond, namzgr )
IF(lwp) THEN ! Control print
WRITE(numout,*)
WRITE(numout,*) 'dom_zgr : vertical coordinate'
WRITE(numout,*) '~~~~~~~'
WRITE(numout,*) ' Namelist namzgr : set vertical coordinate'
WRITE(numout,*) ' z-coordinate - full steps ln_zco = ', ln_zco
WRITE(numout,*) ' z-coordinate - partial steps ln_zps = ', ln_zps
WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco
WRITE(numout,*) ' ice shelf cavities ln_isfcav = ', ln_isfcav
ENDIF
ioptio = 0 ! Check Vertical coordinate options
IF( ln_zco ) ioptio = ioptio + 1
IF( ln_zps ) ioptio = ioptio + 1
IF( ln_sco ) ioptio = ioptio + 1
IF( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' )
!
! Build the vertical coordinate system
! ------------------------------------
CALL zgr_z ! Reference z-coordinate system (always called)
CALL zgr_bat ! Bathymetry fields (levels and meters)
IF( lk_c1d ) CALL lbc_lnk( bathy , 'T', 1._wp ) ! 1D config.: same bathy value over the 3x3 domain
IF( ln_zco ) CALL zgr_zco ! z-coordinate
IF( ln_zps ) CALL zgr_zps ! Partial step z-coordinate
IF( ln_sco ) CALL zgr_sco ! s-coordinate or hybrid z-s coordinate
!
! final adjustment of mbathy & check
! -----------------------------------
IF( lzoom ) CALL zgr_bat_zoom ! correct mbathy in case of zoom subdomain
IF( .NOT.lk_c1d ) CALL zgr_bat_ctl ! check bathymetry (mbathy) and suppress isolated ocean points
CALL zgr_bot_level ! deepest ocean level for t-, u- and v-points
CALL zgr_top_level ! shallowest ocean level for T-, U-, V- points
!
IF( lk_c1d ) THEN ! 1D config.: same mbathy value over the 3x3 domain
ibat = mbathy(2,2)
mbathy(:,:) = ibat
END IF
!
IF( nprint == 1 .AND. lwp ) THEN
WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )
WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ), &
& ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gdep3w_0(:,:,:) )
WRITE(numout,*) ' MIN val e3 t ', MINVAL( e3t_0(:,:,:) ), ' f ', MINVAL( e3f_0(:,:,:) ), &
& ' u ', MINVAL( e3u_0(:,:,:) ), ' u ', MINVAL( e3v_0(:,:,:) ), &
& ' uw', MINVAL( e3uw_0(:,:,:)), ' vw', MINVAL( e3vw_0(:,:,:)), &
& ' w ', MINVAL( e3w_0(:,:,:) )
WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ), &
& ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gdep3w_0(:,:,:) )
WRITE(numout,*) ' MAX val e3 t ', MAXVAL( e3t_0(:,:,:) ), ' f ', MAXVAL( e3f_0(:,:,:) ), &
& ' u ', MAXVAL( e3u_0(:,:,:) ), ' u ', MAXVAL( e3v_0(:,:,:) ), &
& ' uw', MAXVAL( e3uw_0(:,:,:)), ' vw', MAXVAL( e3vw_0(:,:,:)), &
& ' w ', MAXVAL( e3w_0(:,:,:) )
ENDIF
!
IF( nn_timing == 1 ) CALL timing_stop('dom_zgr')
!
END SUBROUTINE dom_zgr
SUBROUTINE zgr_z
!!----------------------------------------------------------------------
!! *** ROUTINE zgr_z ***
!!
!! ** Purpose : set the depth of model levels and the resulting
!! vertical scale factors.
!!
!! ** Method : z-coordinate system (use in all type of coordinate)
!! The depth of model levels is defined from an analytical
!! function the derivative of which gives the scale factors.
!! both depth and scale factors only depend on k (1d arrays).
!! w-level: gdepw_1d = gdep(k)
!! e3w_1d(k) = dk(gdep)(k) = e3(k)
!! t-level: gdept_1d = gdep(k+0.5)
!! e3t_1d(k) = dk(gdep)(k+0.5) = e3(k+0.5)
!!
!! ** Action : - gdept_1d, gdepw_1d : depth of T- and W-point (m)
!! - e3t_1d , e3w_1d : scale factors at T- and W-levels (m)
!!
!! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
!!----------------------------------------------------------------------
INTEGER :: jk ! dummy loop indices
REAL(wp) :: zt, zw ! temporary scalars
REAL(wp) :: zsur, za0, za1, zkth ! Values set from parameters in
REAL(wp) :: zacr, zdzmin, zhmax ! par_CONFIG_Rxx.h90
REAL(wp) :: zrefdep ! depth of the reference level (~10m)
REAL(wp) :: za2, zkth2, zacr2 ! Values for optional double tanh function set from parameters
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('zgr_z')
!
! Set variables from parameters
! ------------------------------
zkth = ppkth ; zacr = ppacr
zdzmin = ppdzmin ; zhmax = pphmax
zkth2 = ppkth2 ; zacr2 = ppacr2 ! optional (ldbletanh=T) double tanh parameters
! If ppa1 and ppa0 and ppsur are et to pp_to_be_computed
! za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
IF( ppa1 == pp_to_be_computed .AND. &
& ppa0 == pp_to_be_computed .AND. &
& ppsur == pp_to_be_computed ) THEN
!
#if defined key_agrif
za1 = ( ppdzmin - pphmax / FLOAT(jpkdta-1) ) &
& / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpkdta-1) * ( LOG( COSH( (jpkdta - ppkth) / ppacr) )&
& - LOG( COSH( ( 1 - ppkth) / ppacr) ) ) )
#else
za1 = ( ppdzmin - pphmax / FLOAT(jpkm1) ) &
& / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * ( LOG( COSH( (jpk - ppkth) / ppacr) ) &
& - LOG( COSH( ( 1 - ppkth) / ppacr) ) ) )
#endif
za0 = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr ) )
ELSE
za1 = ppa1 ; za0 = ppa0 ; zsur = ppsur
za2 = ppa2 ! optional (ldbletanh=T) double tanh parameter
ENDIF
IF(lwp) THEN ! Parameter print
WRITE(numout,*)
WRITE(numout,*) ' zgr_z : Reference vertical z-coordinates'
WRITE(numout,*) ' ~~~~~~~'
IF( ppkth == 0._wp ) THEN
WRITE(numout,*) ' Uniform grid with ',jpk-1,' layers'
WRITE(numout,*) ' Total depth :', zhmax
#if defined key_agrif
WRITE(numout,*) ' Layer thickness:', zhmax/(jpkdta-1)
#else
WRITE(numout,*) ' Layer thickness:', zhmax/(jpk-1)
#endif
ELSE
IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN
WRITE(numout,*) ' zsur, za0, za1 computed from '
WRITE(numout,*) ' zdzmin = ', zdzmin
WRITE(numout,*) ' zhmax = ', zhmax
ENDIF
WRITE(numout,*) ' Value of coefficients for vertical mesh:'
WRITE(numout,*) ' zsur = ', zsur
WRITE(numout,*) ' za0 = ', za0
WRITE(numout,*) ' za1 = ', za1
WRITE(numout,*) ' zkth = ', zkth
WRITE(numout,*) ' zacr = ', zacr
IF( ldbletanh ) THEN
WRITE(numout,*) ' (Double tanh za2 = ', za2
WRITE(numout,*) ' parameters) zkth2= ', zkth2
WRITE(numout,*) ' zacr2= ', zacr2
ENDIF
ENDIF
ENDIF
! Reference z-coordinate (depth - scale factor at T- and W-points)
! ======================
IF( ppkth == 0._wp ) THEN ! uniform vertical grid
#if defined key_agrif
za1 = zhmax / FLOAT(jpkdta-1)
#else
za1 = zhmax / FLOAT(jpk-1)
#endif
DO jk = 1, jpk
zw = FLOAT( jk )
zt = FLOAT( jk ) + 0.5_wp
gdepw_1d(jk) = ( zw - 1 ) * za1
gdept_1d(jk) = ( zt - 1 ) * za1
e3w_1d (jk) = za1
e3t_1d (jk) = za1
END DO
ELSE ! Madec & Imbard 1996 function
IF( .NOT. ldbletanh ) THEN
DO jk = 1, jpk
zw = REAL( jk , wp )
zt = REAL( jk , wp ) + 0.5_wp
gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) ) )
gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) ) )
e3w_1d (jk) = za0 + za1 * TANH( (zw-zkth) / zacr )
e3t_1d (jk) = za0 + za1 * TANH( (zt-zkth) / zacr )
END DO
ELSE
DO jk = 1, jpk
zw = FLOAT( jk )
zt = FLOAT( jk ) + 0.5_wp
! Double tanh function
gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr ) ) &
& + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) ) )
gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr ) ) &
& + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) ) )
e3w_1d (jk) = za0 + za1 * TANH( (zw-zkth ) / zacr ) &
& + za2 * TANH( (zw-zkth2) / zacr2 )
e3t_1d (jk) = za0 + za1 * TANH( (zt-zkth ) / zacr ) &
& + za2 * TANH( (zt-zkth2) / zacr2 )
END DO
ENDIF
gdepw_1d(1) = 0._wp ! force first w-level to be exactly at zero
ENDIF
IF ( ln_isfcav ) THEN
! need to be like this to compute the pressure gradient with ISF. If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
DO jk = 1, jpkm1
e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk)
END DO
e3t_1d(jpk) = e3t_1d(jpk-1) ! we don't care because this level is masked in NEMO
DO jk = 2, jpk
e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1)
END DO
e3w_1d(1 ) = 2._wp * (gdept_1d(1) - gdepw_1d(1))
END IF
!!gm BUG in s-coordinate this does not work!
! deepest/shallowest W level Above/Below ~10m
zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d ) ! ref. depth with tolerance (10% of minimum layer thickness)
nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m
nla10 = nlb10 - 1 ! deepest W level Above ~10m
!!gm end bug
IF(lwp) THEN ! control print
WRITE(numout,*)
WRITE(numout,*) ' Reference z-coordinate depth and scale factors:'
WRITE(numout, "(9x,' level gdept_1d gdepw_1d e3t_1d e3w_1d ')" )
WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_1d(jk), gdepw_1d(jk), e3t_1d(jk), e3w_1d(jk), jk = 1, jpk )
ENDIF
DO jk = 1, jpk ! control positivity
IF( e3w_1d (jk) <= 0._wp .OR. e3t_1d (jk) <= 0._wp ) CALL ctl_stop( 'dom:zgr_z: e3w_1d or e3t_1d =< 0 ' )
IF( gdepw_1d(jk) < 0._wp .OR. gdept_1d(jk) < 0._wp ) CALL ctl_stop( 'dom:zgr_z: gdepw_1d or gdept_1d < 0 ' )
END DO
!
IF( nn_timing == 1 ) CALL timing_stop('zgr_z')
!
END SUBROUTINE zgr_z
SUBROUTINE zgr_bat
!!----------------------------------------------------------------------
!! *** ROUTINE zgr_bat ***
!!
!! ** Purpose : set bathymetry both in levels and meters
!!
!! ** Method : read or define mbathy and bathy arrays
!! * level bathymetry:
!! The ocean basin geometry is given by a two-dimensional array,
!! mbathy, which is defined as follow :
!! mbathy(ji,jj) = 1, ..., jpk-1, the number of ocean level
!! at t-point (ji,jj).
!! = 0 over the continental t-point.
!! The array mbathy is checked to verified its consistency with
!! model option. in particular:
!! mbathy must have at least 1 land grid-points (mbathy<=0)
!! along closed boundary.
!! mbathy must be cyclic IF jperio=1.
!! mbathy must be lower or equal to jpk-1.
!! isolated ocean grid points are suppressed from mbathy
!! since they are only connected to remaining
!! ocean through vertical diffusion.
!! ntopo=-1 : rectangular channel or bassin with a bump
!! ntopo= 0 : flat rectangular channel or basin
!! ntopo= 1 : mbathy is read in 'bathy_level.nc' NetCDF file
!! bathy is read in 'bathy_meter.nc' NetCDF file
!!
!! ** Action : - mbathy: level bathymetry (in level index)
!! - bathy : meter bathymetry (in meters)
!!----------------------------------------------------------------------
INTEGER :: ji, jj, jl, jk ! dummy loop indices
INTEGER :: inum ! temporary logical unit
INTEGER :: ierror ! error flag
INTEGER :: ii_bump, ij_bump, ih ! bump center position
INTEGER :: ii0, ii1, ij0, ij1, ik ! local indices
REAL(wp) :: r_bump , h_bump , h_oce ! bump characteristics
REAL(wp) :: zi, zj, zh, zhmin ! local scalars
INTEGER , ALLOCATABLE, DIMENSION(:,:) :: idta ! global domain integer data
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta ! global domain scalar data
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('zgr_bat')
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' zgr_bat : defines level and meter bathymetry'
IF(lwp) WRITE(numout,*) ' ~~~~~~~'
! ! ================== !
IF( ntopo == 0 .OR. ntopo == -1 ) THEN ! defined by hand !
! ! ================== !
! ! global domain level and meter bathymetry (idta,zdta)
!
ALLOCATE( idta(jpidta,jpjdta), STAT=ierror )
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate idta array' )
ALLOCATE( zdta(jpidta,jpjdta), STAT=ierror )
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate zdta array' )
!
IF( ntopo == 0 ) THEN ! flat basin
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' bathymetry field: flat basin'
IF( rn_bathy > 0.01 ) THEN
IF(lwp) WRITE(numout,*) ' Depth = rn_bathy read in namelist'
zdta(:,:) = rn_bathy
IF( ln_sco ) THEN ! s-coordinate (zsc ): idta()=jpk
idta(:,:) = jpkm1
ELSE ! z-coordinate (zco or zps): step-like topography
idta(:,:) = jpkm1
DO jk = 1, jpkm1
WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) ) idta(:,:) = jk
END DO
ENDIF
ELSE
IF(lwp) WRITE(numout,*) ' Depth = depthw(jpkm1)'
idta(:,:) = jpkm1 ! before last level
zdta(:,:) = gdepw_1d(jpk) ! last w-point depth
h_oce = gdepw_1d(jpk)
ENDIF
ELSE ! bump centered in the basin
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' bathymetry field: flat basin with a bump'
ii_bump = jpidta / 2 ! i-index of the bump center
ij_bump = jpjdta / 2 ! j-index of the bump center
r_bump = 50000._wp ! bump radius (meters)
h_bump = 2700._wp ! bump height (meters)
h_oce = gdepw_1d(jpk) ! background ocean depth (meters)
IF(lwp) WRITE(numout,*) ' bump characteristics: '
IF(lwp) WRITE(numout,*) ' bump center (i,j) = ', ii_bump, ii_bump
IF(lwp) WRITE(numout,*) ' bump height = ', h_bump , ' meters'
IF(lwp) WRITE(numout,*) ' bump radius = ', r_bump , ' index'
IF(lwp) WRITE(numout,*) ' background ocean depth = ', h_oce , ' meters'
!
DO jj = 1, jpjdta ! zdta :
DO ji = 1, jpidta
zi = FLOAT( ji - ii_bump ) * ppe1_m / r_bump
zj = FLOAT( jj - ij_bump ) * ppe2_m / r_bump
zdta(ji,jj) = h_oce - h_bump * EXP( -( zi*zi + zj*zj ) )
END DO
END DO
! ! idta :
IF( ln_sco ) THEN ! s-coordinate (zsc ): idta()=jpk
idta(:,:) = jpkm1
ELSE ! z-coordinate (zco or zps): step-like topography
idta(:,:) = jpkm1
DO jk = 1, jpkm1
WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) ) idta(:,:) = jk
END DO
ENDIF
ENDIF
! ! set GLOBAL boundary conditions
! ! Caution : idta on the global domain: use of jperio, not nperio
IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
idta( : , 1 ) = -1 ; zdta( : , 1 ) = -1._wp
idta( : ,jpjdta) = 0 ; zdta( : ,jpjdta) = 0._wp
ELSEIF( jperio == 2 ) THEN
idta( : , 1 ) = idta( : , 3 ) ; zdta( : , 1 ) = zdta( : , 3 )
idta( : ,jpjdta) = 0 ; zdta( : ,jpjdta) = 0._wp
idta( 1 , : ) = 0 ; zdta( 1 , : ) = 0._wp
idta(jpidta, : ) = 0 ; zdta(jpidta, : ) = 0._wp
ELSE
ih = 0 ; zh = 0._wp
IF( ln_sco ) ih = jpkm1 ; IF( ln_sco ) zh = h_oce
idta( : , 1 ) = ih ; zdta( : , 1 ) = zh
idta( : ,jpjdta) = ih ; zdta( : ,jpjdta) = zh
idta( 1 , : ) = ih ; zdta( 1 , : ) = zh
idta(jpidta, : ) = ih ; zdta(jpidta, : ) = zh
ENDIF
! ! local domain level and meter bathymetries (mbathy,bathy)
mbathy(:,:) = 0 ! set to zero extra halo points
bathy (:,:) = 0._wp ! (require for mpp case)
DO jj = 1, nlcj ! interior values
DO ji = 1, nlci
mbathy(ji,jj) = idta( mig(ji), mjg(jj) )
bathy (ji,jj) = zdta( mig(ji), mjg(jj) )
END DO
END DO
risfdep(:,:)=0.e0
misfdep(:,:)=1
!
DEALLOCATE( idta, zdta )
!
! ! ================ !
ELSEIF( ntopo == 1 ) THEN ! read in file ! (over the local domain)
! ! ================ !
!
IF( ln_zco ) THEN ! zco : read level bathymetry
CALL iom_open ( 'bathy_level.nc', inum )
CALL iom_get ( inum, jpdom_data, 'Bathy_level', bathy )
CALL iom_close( inum )
mbathy(:,:) = INT( bathy(:,:) )
! ! =====================
IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration
! ! =====================
IF( nn_cla == 0 ) THEN
ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open
ij0 = 102 ; ij1 = 102 ! (Thomson, Ocean Modelling, 1995)
DO ji = mi0(ii0), mi1(ii1)
DO jj = mj0(ij0), mj1(ij1)
mbathy(ji,jj) = 15
END DO
END DO
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
!
ii0 = 160 ; ii1 = 160 ! Bab el mandeb Strait open
ij0 = 88 ; ij1 = 88 ! (Thomson, Ocean Modelling, 1995)
DO ji = mi0(ii0), mi1(ii1)
DO jj = mj0(ij0), mj1(ij1)
mbathy(ji,jj) = 12
END DO
END DO
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
ENDIF
!
ENDIF
!
ENDIF
IF( ln_zps .OR. ln_sco ) THEN ! zps or sco : read meter bathymetry
CALL iom_open ( 'bathy_meter.nc', inum )
IF ( ln_isfcav ) THEN
CALL iom_get ( inum, jpdom_data, 'Bathymetry_isf', bathy, lrowattr=.false. )
ELSE
CALL iom_get ( inum, jpdom_data, 'Bathymetry' , bathy, lrowattr=ln_use_jattr )
END IF
CALL iom_close( inum )
!
risfdep(:,:)=0._wp
misfdep(:,:)=1
IF ( ln_isfcav ) THEN
CALL iom_open ( 'isf_draft_meter.nc', inum )
CALL iom_get ( inum, jpdom_data, 'isf_draft', risfdep )
CALL iom_close( inum )
WHERE( bathy(:,:) <= 0._wp ) risfdep(:,:) = 0._wp
END IF
!
IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration
!
IF( nn_cla == 0 ) THEN
ii0 = 140 ; ii1 = 140 ! Gibraltar Strait open
ij0 = 102 ; ij1 = 102 ! (Thomson, Ocean Modelling, 1995)
DO ji = mi0(ii0), mi1(ii1)
DO jj = mj0(ij0), mj1(ij1)
bathy(ji,jj) = 284._wp
END DO
END DO
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
!
ii0 = 160 ; ii1 = 160 ! Bab el mandeb Strait open
ij0 = 88 ; ij1 = 88 ! (Thomson, Ocean Modelling, 1995)
DO ji = mi0(ii0), mi1(ii1)
DO jj = mj0(ij0), mj1(ij1)
bathy(ji,jj) = 137._wp
END DO
END DO
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
ENDIF
!
ENDIF
!
ENDIF
! ! =============== !
ELSE ! error !
! ! =============== !
WRITE(ctmp1,*) 'parameter , ntopo = ', ntopo
CALL ctl_stop( ' zgr_bat : '//trim(ctmp1) )
ENDIF
!
IF( nn_closea == 0 ) CALL clo_bat( bathy, mbathy ) !== NO closed seas or lakes ==!
!
IF ( .not. ln_sco ) THEN !== set a minimum depth ==!
! patch to avoid case bathy = ice shelf draft and bathy between 0 and zhmin
IF ( ln_isfcav ) THEN
WHERE (bathy == risfdep)
bathy = 0.0_wp ; risfdep = 0.0_wp
END WHERE
END IF
! end patch
IF( rn_hmin < 0._wp ) THEN ; ik = - INT( rn_hmin ) ! from a nb of level
ELSE ; ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 ) ! from a depth
ENDIF
zhmin = gdepw_1d(ik+1) ! minimum depth = ik+1 w-levels
WHERE( bathy(:,:) <= 0._wp ) ; bathy(:,:) = 0._wp ! min=0 over the lands
ELSE WHERE ; bathy(:,:) = MAX( zhmin , bathy(:,:) ) ! min=zhmin over the oceans
END WHERE
IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik
ENDIF
!
IF( nn_timing == 1 ) CALL timing_stop('zgr_bat')
!
END SUBROUTINE zgr_bat
SUBROUTINE zgr_bat_zoom
!!----------------------------------------------------------------------
!! *** ROUTINE zgr_bat_zoom ***
!!
!! ** Purpose : - Close zoom domain boundary if necessary
!! - Suppress Med Sea from ORCA R2 and R05 arctic zoom
!!
!! ** Method :
!!
!! ** Action : - update mbathy: level bathymetry (in level index)
!!----------------------------------------------------------------------
INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers
!!----------------------------------------------------------------------
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' zgr_bat_zoom : modify the level bathymetry for zoom domain'
IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~'
!
! Zoom domain
! ===========
!
! Forced closed boundary if required
IF( lzoom_s ) mbathy( : , mj0(jpjzoom):mj1(jpjzoom) ) = 0
IF( lzoom_w ) mbathy( mi0(jpizoom):mi1(jpizoom) , : ) = 0
IF( lzoom_e ) mbathy( mi0(jpiglo+jpizoom-1):mi1(jpiglo+jpizoom-1) , : ) = 0
IF( lzoom_n ) mbathy( : , mj0(jpjglo+jpjzoom-1):mj1(jpjglo+jpjzoom-1) ) = 0
!
! Configuration specific domain modifications
! (here, ORCA arctic configuration: suppress Med Sea)
IF( cp_cfg == "orca" .AND. cp_cfz == "arctic" ) THEN
SELECT CASE ( jp_cfg )
! ! =======================
CASE ( 2 ) ! ORCA_R2 configuration
! ! =======================
IF(lwp) WRITE(numout,*) ' ORCA R2 arctic zoom: suppress the Med Sea'
ii0 = 141 ; ii1 = 162 ! Sea box i,j indices
ij0 = 98 ; ij1 = 110
! ! =======================
CASE ( 05 ) ! ORCA_R05 configuration
! ! =======================
IF(lwp) WRITE(numout,*) ' ORCA R05 arctic zoom: suppress the Med Sea'
ii0 = 563 ; ii1 = 642 ! zero over the Med Sea boxe
ij0 = 314 ; ij1 = 370
END SELECT
!
mbathy( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0 ! zero over the Med Sea boxe
!
ENDIF
!
END SUBROUTINE zgr_bat_zoom
SUBROUTINE zgr_bat_ctl
!!----------------------------------------------------------------------
!! *** ROUTINE zgr_bat_ctl ***
!!
!! ** Purpose : check the bathymetry in levels
!!
!! ** Method : The array mbathy is checked to verified its consistency
!! with the model options. in particular:
!! mbathy must have at least 1 land grid-points (mbathy<=0)
!! along closed boundary.
!! mbathy must be cyclic IF jperio=1.
!! mbathy must be lower or equal to jpk-1.
!! isolated ocean grid points are suppressed from mbathy
!! since they are only connected to remaining
!! ocean through vertical diffusion.
!! C A U T I O N : mbathy will be modified during the initializa-
!! tion phase to become the number of non-zero w-levels of a water
!! column, with a minimum value of 1.
!!
!! ** Action : - update mbathy: level bathymetry (in level index)
!! - update bathy : meter bathymetry (in meters)
!!----------------------------------------------------------------------
!!
INTEGER :: ji, jj, jl ! dummy loop indices
INTEGER :: icompt, ibtest, ikmax ! temporary integers
REAL(wp), POINTER, DIMENSION(:,:) :: zbathy
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('zgr_bat_ctl')
!
CALL wrk_alloc( jpi, jpj, zbathy )
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' zgr_bat_ctl : check the bathymetry'
IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
! ! Suppress isolated ocean grid points
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*)' suppress isolated ocean grid points'
IF(lwp) WRITE(numout,*)' -----------------------------------'
icompt = 0
DO jl = 1, 2
IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
mbathy( 1 ,:) = mbathy(jpim1,:) ! local domain is cyclic east-west
mbathy(jpi,:) = mbathy( 2 ,:)
ENDIF
DO jj = 2, jpjm1
DO ji = 2, jpim1
ibtest = MAX( mbathy(ji-1,jj), mbathy(ji+1,jj), &
& mbathy(ji,jj-1), mbathy(ji,jj+1) )
IF( ibtest < mbathy(ji,jj) ) THEN
IF(lwp) WRITE(numout,*) ' the number of ocean level at ', &
& 'grid-point (i,j) = ',ji,jj,' is changed from ', mbathy(ji,jj),' to ', ibtest
mbathy(ji,jj) = ibtest
icompt = icompt + 1
ENDIF
END DO
END DO
END DO
IF( lk_mpp ) CALL mpp_sum( icompt )
IF( icompt == 0 ) THEN
IF(lwp) WRITE(numout,*)' no isolated ocean grid points'
ELSE
IF(lwp) WRITE(numout,*)' ',icompt,' ocean grid points suppressed'
ENDIF
IF( lk_mpp ) THEN
zbathy(:,:) = FLOAT( mbathy(:,:) )
CALL lbc_lnk( zbathy, 'T', 1._wp )
mbathy(:,:) = INT( zbathy(:,:) )
ENDIF
! ! East-west cyclic boundary conditions
IF( nperio == 0 ) THEN
IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: nperio = ', nperio
IF( lk_mpp ) THEN
IF( nbondi == -1 .OR. nbondi == 2 ) THEN
IF( jperio /= 1 ) mbathy(1,:) = 0
ENDIF
IF( nbondi == 1 .OR. nbondi == 2 ) THEN
IF( jperio /= 1 ) mbathy(nlci,:) = 0
ENDIF
ELSE
IF( ln_zco .OR. ln_zps ) THEN
mbathy( 1 ,:) = 0
mbathy(jpi,:) = 0
ELSE
mbathy( 1 ,:) = jpkm1
mbathy(jpi,:) = jpkm1
ENDIF
ENDIF
ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: nperio = ', nperio
mbathy( 1 ,:) = mbathy(jpim1,:)
mbathy(jpi,:) = mbathy( 2 ,:)
ELSEIF( nperio == 2 ) THEN
IF(lwp) WRITE(numout,*) ' equatorial boundary conditions on mbathy: nperio = ', nperio
ELSE
IF(lwp) WRITE(numout,*) ' e r r o r'
IF(lwp) WRITE(numout,*) ' parameter , nperio = ', nperio
! STOP 'dom_mba'
ENDIF
! Boundary condition on mbathy
IF( .NOT.lk_mpp ) THEN
!!gm !!bug ??? think about it !
! ... mono- or macro-tasking: T-point, >0, 2D array, no slab
zbathy(:,:) = FLOAT( mbathy(:,:) )
CALL lbc_lnk( zbathy, 'T', 1._wp )
mbathy(:,:) = INT( zbathy(:,:) )
ENDIF
! Number of ocean level inferior or equal to jpkm1
ikmax = 0
DO jj = 1, jpj
DO ji = 1, jpi
ikmax = MAX( ikmax, mbathy(ji,jj) )
END DO
END DO
!!gm !!! test to do: ikmax = MAX( mbathy(:,:) ) ???
IF( ikmax > jpkm1 ) THEN
IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' > jpk-1'
IF(lwp) WRITE(numout,*) ' change jpk to ',ikmax+1,' to use the exact ead bathymetry'
ELSE IF( ikmax < jpkm1 ) THEN
IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' < jpk-1'
IF(lwp) WRITE(numout,*) ' you can decrease jpk to ', ikmax+1
ENDIF
IF( lwp .AND. nprint == 1 ) THEN ! control print
WRITE(numout,*)
WRITE(numout,*) ' bathymetric field : number of non-zero T-levels '
WRITE(numout,*) ' ------------------'
CALL prihin( mbathy, jpi, jpj, 1, jpi, 1, 1, jpj, 1, 3, numout )
WRITE(numout,*)
ENDIF
!
CALL wrk_dealloc( jpi, jpj, zbathy )
!
IF( nn_timing == 1 ) CALL timing_stop('zgr_bat_ctl')
!
END SUBROUTINE zgr_bat_ctl
SUBROUTINE zgr_bot_level
!!----------------------------------------------------------------------
!! *** ROUTINE zgr_bot_level ***
!!
!! ** Purpose : defines the vertical index of ocean bottom (mbk. arrays)
!!
!! ** Method : computes from mbathy with a minimum value of 1 over land
!!
!! ** Action : mbkt, mbku, mbkv : vertical indices of the deeptest
!! ocean level at t-, u- & v-points
!! (min value = 1 over land)
!!----------------------------------------------------------------------
!!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp), POINTER, DIMENSION(:,:) :: zmbk
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('zgr_bot_level')
!
CALL wrk_alloc( jpi, jpj, zmbk )
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' zgr_bot_level : ocean bottom k-index of T-, U-, V- and W-levels '
IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~'
!
mbkt(:,:) = MAX( mbathy(:,:) , 1 ) ! bottom k-index of T-level (=1 over land)
! ! bottom k-index of W-level = mbkt+1
DO jj = 1, jpjm1 ! bottom k-index of u- (v-) level
DO ji = 1, jpim1
mbku(ji,jj) = MIN( mbkt(ji+1,jj ) , mbkt(ji,jj) )
mbkv(ji,jj) = MIN( mbkt(ji ,jj+1) , mbkt(ji,jj) )
END DO
END DO
! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
zmbk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk(zmbk,'U',1.) ; mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 )
zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 )
!
CALL wrk_dealloc( jpi, jpj, zmbk )
!
IF( nn_timing == 1 ) CALL timing_stop('zgr_bot_level')
!
END SUBROUTINE zgr_bot_level
SUBROUTINE zgr_top_level
!!----------------------------------------------------------------------
!! *** ROUTINE zgr_bot_level ***
!!
!! ** Purpose : defines the vertical index of ocean top (mik. arrays)
!!
!! ** Method : computes from misfdep with a minimum value of 1
!!
!! ** Action : mikt, miku, mikv : vertical indices of the shallowest
!! ocean level at t-, u- & v-points
!! (min value = 1)
!!----------------------------------------------------------------------
!!
INTEGER :: ji, jj ! dummy loop indices
REAL(wp), POINTER, DIMENSION(:,:) :: zmik
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('zgr_top_level')
!
CALL wrk_alloc( jpi, jpj, zmik )
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' zgr_top_level : ocean top k-index of T-, U-, V- and W-levels '
IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~'
!
mikt(:,:) = MAX( misfdep(:,:) , 1 ) ! top k-index of T-level (=1)
! ! top k-index of W-level (=mikt)
DO jj = 1, jpjm1 ! top k-index of U- (U-) level
DO ji = 1, jpim1
miku(ji,jj) = MAX( mikt(ji+1,jj ) , mikt(ji,jj) )
mikv(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj) )
mikf(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj), mikt(ji+1,jj ), mikt(ji+1,jj+1) )
END DO
END DO
! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
zmik(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk(zmik,'U',1.) ; miku (:,:) = MAX( INT( zmik(:,:) ), 1 )
zmik(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk(zmik,'V',1.) ; mikv (:,:) = MAX( INT( zmik(:,:) ), 1 )
zmik(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk(zmik,'F',1.) ; mikf (:,:) = MAX( INT( zmik(:,:) ), 1 )
!
CALL wrk_dealloc( jpi, jpj, zmik )
!
IF( nn_timing == 1 ) CALL timing_stop('zgr_top_level')
!
END SUBROUTINE zgr_top_level
SUBROUTINE zgr_zco
!!----------------------------------------------------------------------
!! *** ROUTINE zgr_zco ***
!!
!! ** Purpose : define the z-coordinate system
!!
!! ** Method : set 3D coord. arrays to reference 1D array
!!----------------------------------------------------------------------
INTEGER :: jk
!!----------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('zgr_zco')
!
DO jk = 1, jpk
gdept_0 (:,:,jk) = gdept_1d(jk)
gdepw_0 (:,:,jk) = gdepw_1d(jk)
gdep3w_0(:,:,jk) = gdepw_1d(jk)
e3t_0 (:,:,jk) = e3t_1d (jk)
e3u_0 (:,:,jk) = e3t_1d (jk)
e3v_0 (:,:,jk) = e3t_1d (jk)
e3f_0 (:,:,jk) = e3t_1d (jk)
e3w_0 (:,:,jk) = e3w_1d (jk)
e3uw_0 (:,:,jk) = e3w_1d (jk)
e3vw_0 (:,:,jk) = e3w_1d (jk)
END DO
!
IF( nn_timing == 1 ) CALL timing_stop('zgr_zco')
!
END SUBROUTINE zgr_zco
SUBROUTINE zgr_zps
!!----------------------------------------------------------------------
!! *** ROUTINE zgr_zps ***
!!
!! ** Purpose : the depth and vertical scale factor in partial step
!! z-coordinate case
!!
!! ** Method : Partial steps : computes the 3D vertical scale factors
!! of T-, U-, V-, W-, UW-, VW and F-points that are associated with
!! a partial step representation of bottom topography.
!!
!! The reference depth of model levels is defined from an analytical
!! function the derivative of which gives the reference vertical
!! scale factors.
!! From depth and scale factors reference, we compute there new value
!! with partial steps on 3d arrays ( i, j, k ).
!!
!! w-level: gdepw_0(i,j,k) = gdep(k)
!! e3w_0(i,j,k) = dk(gdep)(k) = e3(i,j,k)
!! t-level: gdept_0(i,j,k) = gdep(k+0.5)
!! e3t_0(i,j,k) = dk(gdep)(k+0.5) = e3(i,j,k+0.5)
!!
!! With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
!! we find the mbathy index of the depth at each grid point.
!! This leads us to three cases:
!!
!! - bathy = 0 => mbathy = 0
!! - 1 < mbathy < jpkm1
!! - bathy > gdepw_0(jpk) => mbathy = jpkm1
!!
!! Then, for each case, we find the new depth at t- and w- levels
!! and the new vertical scale factors at t-, u-, v-, w-, uw-, vw-
!! and f-points.
!!
!! This routine is given as an example, it must be modified
!! following the user s desiderata. nevertheless, the output as
!! well as the way to compute the model levels and scale factors
!! must be respected in order to insure second order accuracy
!! schemes.
!!
!! c a u t i o n : gdept_1d, gdepw_1d and e3._1d are positives
!! - - - - - - - gdept_0, gdepw_0 and e3. are positives
!!
!! Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
!!----------------------------------------------------------------------
!!
INTEGER :: ji, jj, jk ! dummy loop indices
INTEGER :: ik, it, ikb, ikt ! temporary integers
LOGICAL :: ll_print ! Allow control print for debugging
REAL(wp) :: ze3tp , ze3wp ! Last ocean level thickness at T- and W-points
REAL(wp) :: zdepwp, zdepth ! Ajusted ocean depth to avoid too small e3t
REAL(wp) :: zmax ! Maximum depth
REAL(wp) :: zdiff ! temporary scalar
REAL(wp) :: zrefdep ! temporary scalar
REAL(wp), POINTER, DIMENSION(:,:,:) :: zprt
!!---------------------------------------------------------------------
!
IF( nn_timing == 1 ) CALL timing_start('zgr_zps')
!
CALL wrk_alloc( jpi, jpj, jpk, zprt )
!
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' zgr_zps : z-coordinate with partial steps'
IF(lwp) WRITE(numout,*) ' ~~~~~~~ '
IF(lwp) WRITE(numout,*) ' mbathy is recomputed : bathy_level file is NOT used'
ll_print = .FALSE. ! Local variable for debugging
IF(lwp .AND. ll_print) THEN ! control print of the ocean depth
WRITE(numout,*)
WRITE(numout,*) 'dom_zgr_zps: bathy (in hundred of meters)'
CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout )
ENDIF
! bathymetry in level (from bathy_meter)
! ===================
zmax = gdepw_1d(jpk) + e3t_1d(jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
bathy(:,:) = MIN( zmax , bathy(:,:) ) ! bounded value of bathy (min already set at the end of zgr_bat)
WHERE( bathy(:,:) == 0._wp ) ; mbathy(:,:) = 0 ! land : set mbathy to 0
ELSE WHERE ; mbathy(:,:) = jpkm1 ! ocean : initialize mbathy to the max ocean level
END WHERE
! Compute mbathy for ocean points (i.e. the number of ocean levels)