[6717] | 1 | MODULE usrdef_fmask |
---|
| 2 | !!====================================================================== |
---|
[6923] | 3 | !! *** MODULE usrdef_fmask *** |
---|
| 4 | !! |
---|
| 5 | !! === ORCA configuration === |
---|
| 6 | !! (2 and 1 degrees) |
---|
| 7 | !! |
---|
| 8 | !! User defined : alteration of land/sea f-point mask in some straits |
---|
[6717] | 9 | !!====================================================================== |
---|
| 10 | !! History : 4.0 ! 2016-06 (G. Madec, S. Flavoni) Original code |
---|
| 11 | !!---------------------------------------------------------------------- |
---|
| 12 | |
---|
| 13 | !!---------------------------------------------------------------------- |
---|
| 14 | !! usr_def_fmask : alteration of f-point land/ocean mask in some straits |
---|
| 15 | !!---------------------------------------------------------------------- |
---|
| 16 | USE oce ! ocean dynamics and tracers |
---|
| 17 | USE dom_oce ! ocean space and time domain |
---|
| 18 | ! |
---|
| 19 | USE in_out_manager ! I/O manager |
---|
| 20 | USE lbclnk ! ocean lateral boundary conditions (or mpp link) |
---|
| 21 | USE lib_mpp ! Massively Parallel Processing library |
---|
| 22 | |
---|
| 23 | IMPLICIT NONE |
---|
| 24 | PRIVATE |
---|
| 25 | |
---|
| 26 | PUBLIC usr_def_fmask ! routine called by dommsk.F90 |
---|
| 27 | |
---|
| 28 | !! * Substitutions |
---|
| 29 | # include "vectopt_loop_substitute.h90" |
---|
| 30 | !!---------------------------------------------------------------------- |
---|
[9598] | 31 | !! NEMO/OCE 4.0 , NEMO Consortium (2018) |
---|
[13587] | 32 | !! $Id$ |
---|
[10068] | 33 | !! Software governed by the CeCILL license (see ./LICENSE) |
---|
[6717] | 34 | !!---------------------------------------------------------------------- |
---|
| 35 | CONTAINS |
---|
| 36 | |
---|
| 37 | SUBROUTINE usr_def_fmask( cd_cfg, kcfg, pfmsk ) |
---|
| 38 | !!--------------------------------------------------------------------- |
---|
| 39 | !! *** ROUTINE dom_msk *** |
---|
| 40 | !! |
---|
| 41 | !! ** Purpose : User defined alteration of the lateral boundary |
---|
| 42 | !! condition on velocity. |
---|
| 43 | !! |
---|
| 44 | !! ** Method : Local change of the value of fmask at lateral ocean/land |
---|
| 45 | !! boundary in straits in order to increase the viscous |
---|
| 46 | !! boundary layer and thus reduce the transport through the |
---|
| 47 | !! corresponding straits. |
---|
| 48 | !! Here only alterations in ORCA R2 and R1 cases |
---|
| 49 | !! |
---|
| 50 | !! ** Action : fmask : land/ocean mask at f-point with increased value |
---|
| 51 | !! in some user defined straits |
---|
| 52 | !!---------------------------------------------------------------------- |
---|
[6979] | 53 | CHARACTER(len=*) , INTENT(in ) :: cd_cfg ! configuration name |
---|
[6717] | 54 | INTEGER , INTENT(in ) :: kcfg ! configuration identifier |
---|
| 55 | REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pfmsk ! Ocean/Land f-point mask including lateral boundary cond. |
---|
| 56 | ! |
---|
| 57 | INTEGER :: iif, iil, ii0, ii1, ii ! local integers |
---|
| 58 | INTEGER :: ijf, ijl, ij0, ij1 ! - - |
---|
| 59 | INTEGER :: isrow ! index for ORCA1 starting row |
---|
| 60 | !!---------------------------------------------------------------------- |
---|
| 61 | ! |
---|
[6979] | 62 | IF( TRIM( cd_cfg ) == "orca" ) THEN !== ORCA Configurations ==! |
---|
[6717] | 63 | ! |
---|
| 64 | SELECT CASE ( kcfg ) |
---|
| 65 | ! |
---|
| 66 | CASE( 2 ) ! R2 case |
---|
| 67 | IF(lwp) WRITE(numout,*) |
---|
| 68 | IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R2: increase lateral friction near the following straits:' |
---|
| 69 | IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' |
---|
| 70 | ! |
---|
| 71 | IF(lwp) WRITE(numout,*) ' Gibraltar ' |
---|
| 72 | ij0 = 101 ; ij1 = 101 ! Gibraltar strait : partial slip (pfmsk=0.5) |
---|
| 73 | ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp |
---|
| 74 | ij0 = 102 ; ij1 = 102 |
---|
| 75 | ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp |
---|
| 76 | ! |
---|
| 77 | IF(lwp) WRITE(numout,*) ' Bab el Mandeb ' |
---|
| 78 | ij0 = 87 ; ij1 = 88 ! Bab el Mandeb : partial slip (pfmsk=1) |
---|
| 79 | ii0 = 160 ; ii1 = 160 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp |
---|
| 80 | ij0 = 88 ; ij1 = 88 |
---|
| 81 | ii0 = 159 ; ii1 = 159 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp |
---|
| 82 | ! |
---|
| 83 | ! We keep this as an example but it is instable in this case |
---|
| 84 | !IF(lwp) WRITE(numout,*) ' Danish straits ' |
---|
| 85 | ! ij0 = 115 ; ij1 = 115 ! Danish straits : strong slip (pfmsk > 2) |
---|
| 86 | ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp |
---|
| 87 | ! ij0 = 116 ; ij1 = 116 |
---|
| 88 | ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp |
---|
| 89 | ! |
---|
| 90 | CASE( 1 ) ! R1 case |
---|
| 91 | IF(lwp) WRITE(numout,*) |
---|
| 92 | IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R1: increase lateral friction near the following straits:' |
---|
| 93 | IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' |
---|
| 94 | !!gm ! This dirty section will be suppressed by simplification process: |
---|
| 95 | !!gm ! all this will come back in input files |
---|
| 96 | !!gm ! Currently these hard-wired indices relate to configuration with extend grid (jpjglo=332) |
---|
| 97 | ! |
---|
| 98 | isrow = 332 - jpjglo |
---|
| 99 | ! |
---|
| 100 | IF(lwp) WRITE(numout,*) |
---|
| 101 | IF(lwp) WRITE(numout,*) ' orca_r1: increase friction near the following straits : ' |
---|
| 102 | IF(lwp) WRITE(numout,*) ' Gibraltar ' |
---|
| 103 | ii0 = 282 ; ii1 = 283 ! Gibraltar Strait |
---|
| 104 | ij0 = 241 - isrow ; ij1 = 241 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp |
---|
| 105 | ! |
---|
| 106 | IF(lwp) WRITE(numout,*) ' Bhosporus ' |
---|
| 107 | ii0 = 314 ; ii1 = 315 ! Bhosporus Strait |
---|
| 108 | ij0 = 248 - isrow ; ij1 = 248 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp |
---|
| 109 | ! |
---|
| 110 | IF(lwp) WRITE(numout,*) ' Makassar (Top) ' |
---|
| 111 | ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top) |
---|
| 112 | ij0 = 189 - isrow ; ij1 = 190 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp |
---|
| 113 | ! |
---|
| 114 | IF(lwp) WRITE(numout,*) ' Lombok ' |
---|
| 115 | ii0 = 44 ; ii1 = 44 ! Lombok Strait |
---|
| 116 | ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp |
---|
| 117 | ! |
---|
| 118 | IF(lwp) WRITE(numout,*) ' Ombai ' |
---|
| 119 | ii0 = 53 ; ii1 = 53 ! Ombai Strait |
---|
| 120 | ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp |
---|
| 121 | ! |
---|
| 122 | IF(lwp) WRITE(numout,*) ' Timor Passage ' |
---|
| 123 | ii0 = 56 ; ii1 = 56 ! Timor Passage |
---|
| 124 | ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp |
---|
| 125 | ! |
---|
| 126 | IF(lwp) WRITE(numout,*) ' West Halmahera ' |
---|
| 127 | ii0 = 58 ; ii1 = 58 ! West Halmahera Strait |
---|
| 128 | ij0 = 181 - isrow ; ij1 = 182 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp |
---|
| 129 | ! |
---|
| 130 | IF(lwp) WRITE(numout,*) ' East Halmahera ' |
---|
| 131 | ii0 = 55 ; ii1 = 55 ! East Halmahera Strait |
---|
| 132 | ij0 = 181 - isrow ; ij1 = 182 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp |
---|
| 133 | ! |
---|
| 134 | CASE DEFAULT |
---|
| 135 | IF(lwp) WRITE(numout,*) |
---|
| 136 | IF(lwp) WRITE(numout,*) 'usr_def_fmask : ORCA_R', kcfg,' : NO alteration of fmask in specific straits ' |
---|
| 137 | IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' |
---|
| 138 | END SELECT |
---|
| 139 | ELSE |
---|
| 140 | IF(lwp) WRITE(numout,*) |
---|
| 141 | IF(lwp) WRITE(numout,*) 'usr_def_fmask : NO alteration of fmask in specific straits ' |
---|
| 142 | IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' |
---|
| 143 | ENDIF |
---|
| 144 | ! |
---|
[10425] | 145 | CALL lbc_lnk( 'usrdef_fmask', pfmsk, 'F', 1._wp ) ! Lateral boundary conditions on fmask |
---|
[6717] | 146 | ! |
---|
| 147 | END SUBROUTINE usr_def_fmask |
---|
| 148 | |
---|
| 149 | !!====================================================================== |
---|
| 150 | END MODULE usrdef_fmask |
---|