Changeset 11129 for NEMO/branches/2019/ENHANCE-03_domcfg/src
- Timestamp:
- 2019-06-18T17:11:36+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/ENHANCE-03_domcfg
- Files:
-
- 6 deleted
- 12 edited
- 2 copied
-
. (copied) (copied from utils/tools_AGRIF_CMEMS_2020/DOMAINcfg)
-
src/agrif_modutil.f90 (deleted)
-
src/agrif_user.F90 (modified) (1 diff)
-
src/daymod.f90 (modified) (1 diff)
-
src/dom_oce.F90 (modified) (3 diffs)
-
src/domain.F90 (modified) (4 diffs)
-
src/dombat.F90 (modified) (2 diffs)
-
src/dombat_util.f90 (copied) (copied from utils/tools_AGRIF_CMEMS_2020/DOMAINcfg/src/agrif_modutil.f90)
-
src/domcfg.f90 (modified) (4 diffs)
-
src/domhgr.F90 (modified) (2 diffs)
-
src/dommsk.F90 (modified) (8 diffs)
-
src/domvvl.F90 (deleted)
-
src/domzgr.F90 (modified) (64 diffs)
-
src/iom.F90 (modified) (2 diffs)
-
src/lbclnk.F90 (modified) (1 diff)
-
src/nemogcm.F90 (modified) (7 diffs)
-
src/oce.f90 (deleted)
-
src/prtctl.F90 (deleted)
-
src/step_oce.f90 (deleted)
-
src/wrk_nemo.f90 (deleted)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/ENHANCE-03_domcfg/src/agrif_user.F90
r10727 r11129 12 12 !!---------------------------------------------------------------------- 13 13 USE Agrif_Util 14 USE oce15 14 USE dom_oce 16 15 USE nemogcm -
NEMO/branches/2019/ENHANCE-03_domcfg/src/daymod.f90
r10727 r11129 273 273 274 274 IF( nsec_week > 7*nsecd ) nsec_week = ndt05 ! New week 275 276 IF(ln_ctl) THEN277 WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear278 CALL prt_ctl_info(charout)279 ENDIF280 275 281 276 IF( lrst_oce ) CALL day_rst( kt, 'WRITE' ) ! write day restart information -
NEMO/branches/2019/ENHANCE-03_domcfg/src/dom_oce.F90
r10727 r11129 50 50 LOGICAL, PUBLIC :: lzoom_n = .FALSE. !: North zoom type flag 51 51 52 LOGICAL, PUBLIC :: ln_closea = .FALSE. 52 53 53 54 INTEGER :: jphgr_msh !: type of horizontal mesh … … 202 203 LOGICAL, PUBLIC :: ln_sco !: s-coordinate or hybrid z-s coordinate 203 204 LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF 204 ! ! ref. ! before ! now ! after ! 205 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0 , e3t_b , e3t_n , e3t_a !: t- vert. scale factor [m] 206 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_0 , e3u_b , e3u_n , e3u_a !: u- vert. scale factor [m] 207 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 208 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f_0 , e3f_n !: f- vert. scale factor [m] 209 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0 , e3w_b , e3w_n !: w- vert. scale factor [m] 210 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0 , e3uw_b , e3uw_n !: uw-vert. scale factor [m] 211 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 , e3vw_b , e3vw_n !: vw-vert. scale factor [m] 212 213 ! ! ref. ! before ! now ! 214 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 , gdept_b , gdept_n !: t- depth [m] 215 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 , gdepw_b , gdepw_n !: w- depth [m] 216 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0 , gde3w_n !: w- depth (sum of e3w) [m] 217 218 ! ! ref. ! before ! now ! after ! 219 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 , ht_n !: t-depth [m] 220 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hu_b , hu_n , hu_a !: u-depth [m] 221 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0 , hv_b , hv_n , hv_a !: v-depth [m] 222 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_hu_b , r1_hu_n , r1_hu_a !: inverse of u-depth [1/m] 223 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_hv_b , r1_hv_n , r1_hv_a !: inverse of v-depth [1/m] 205 ! 206 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0, e3u_0 , e3v_0 , e3f_0 !: t-,u-,v-,f-vert. scale factor [m] 207 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0, e3uw_0, e3vw_0 !: w-,uw-,vw-vert. scale factor [m] 208 ! 209 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m] 210 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m] 211 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0 !: w- depth (sum of e3w) [m] 212 ! 213 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 !: t-depth [m] 214 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 !: u-depth [m] 215 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0 !: v-depth [m] 224 216 225 217 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) … … 331 323 & ff_f (jpi,jpj) , ff_t (jpi,jpj) , STAT=ierr(3) ) 332 324 ! 333 ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) , & 334 & gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) , & 335 & gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) ) 336 ! 337 ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , & 338 & e3t_b(jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk) , e3w_b(jpi,jpj,jpk) , & 339 & e3t_n(jpi,jpj,jpk) , e3u_n(jpi,jpj,jpk) , e3v_n(jpi,jpj,jpk) , e3f_n(jpi,jpj,jpk) , e3w_n(jpi,jpj,jpk) , & 340 & e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) , & 341 ! ! 342 & e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , & 343 & e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) , & 344 & e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) , STAT=ierr(5) ) 345 ! 346 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , & 347 & hu_b(jpi,jpj) , hv_b(jpi,jpj) , r1_hu_b(jpi,jpj) , r1_hv_b(jpi,jpj) , & 348 & ht_n(jpi,jpj) , hu_n(jpi,jpj) , hv_n(jpi,jpj) , r1_hu_n(jpi,jpj) , r1_hv_n(jpi,jpj) , & 349 & hu_a(jpi,jpj) , hv_a(jpi,jpj) , r1_hu_a(jpi,jpj) , r1_hv_a(jpi,jpj) , STAT=ierr(6) ) 325 ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) , STAT=ierr(4) ) 326 ! 327 ALLOCATE( e3t_0 (jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , & 328 & e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , STAT=ierr(5) ) 329 ! 330 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , STAT=ierr(6) ) 350 331 ! 351 332 ! -
NEMO/branches/2019/ENHANCE-03_domcfg/src/domain.F90
r10727 r11129 21 21 !! dom_ctl : control print for the ocean domain 22 22 !!---------------------------------------------------------------------- 23 USE oce ! ocean variables24 23 USE dom_oce ! domain: ocean 25 24 USE phycst ! physical constants 26 ! USE closea ! closed seas25 ! USE closea ! closed seas 27 26 USE domhgr ! domain: set the horizontal mesh 28 27 USE domzgr ! domain: set the vertical mesh 29 ! USE domstp ! domain: set the time-step30 28 USE dommsk ! domain: set the mask system 31 29 USE domwri ! domain: write the meshmask file 32 USE domvvl ! variable volume33 30 ! 34 31 USE in_out_manager ! I/O manager 35 32 USE iom ! 36 USE wrk_nemo ! Memory Allocation37 USE lib_mpp ! distributed memory computing library38 USE lbclnk ! ocean lateral boundary condition (or mpp link)39 USE timing ! Timing40 33 41 34 IMPLICIT NONE … … 74 67 !!---------------------------------------------------------------------- 75 68 ! 76 ! IF( nn_timing == 1 ) CALL timing_start('dom_init')77 !78 69 IF(lwp) THEN 79 70 WRITE(numout,*) … … 84 75 ! !== Reference coordinate system ==! 85 76 ! 86 CALL dom_nam ! read namelist ( namrun, namdom ) 87 ! CALL dom_clo ! Closed seas and lake 88 89 CALL dom_hgr ! Horizontal mesh 90 CALL dom_zgr ! Vertical mesh and bathymetry 91 CALL dom_msk ! Masks 77 CALL dom_nam ! read namelist ( namrun, namdom ) 78 ! 79 ! CALL dom_clo ! Closed seas and lake 80 ! 81 CALL dom_hgr ! Horizontal mesh 82 ! 83 CALL dom_zgr ! Vertical mesh and bathymetry 84 ! 85 CALL dom_msk ! Masks 92 86 ! 93 87 ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1) ! Reference ocean thickness … … 100 94 END DO 101 95 ! 102 ! !== time varying part of coordinate system ==! 103 ! 104 IF( ln_linssh ) THEN ! Fix in time : set to the reference one for all 105 ! before ! now ! after ! 106 ; gdept_b = gdept_0 ; gdept_n = gdept_0 ! --- ! depth of grid-points 107 ; gdepw_b = gdepw_0 ; gdepw_n = gdepw_0 ! --- ! 108 ; ; gde3w_n = gde3w_0 ! --- ! 109 ! 110 ; e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale factors 111 ; e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 ! 112 ; e3v_b = e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 ! 113 ; ; e3f_n = e3f_0 ! --- ! 114 ; e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- ! 115 ; e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- ! 116 ; e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- ! 117 ! 118 CALL wrk_alloc( jpi,jpj, z1_hu_0, z1_hv_0 ) 119 ! 120 z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF 121 z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 122 ! 123 ! before ! now ! after ! 124 ; ; ht_n = ht_0 ! ! water column thickness 125 ; hu_b = hu_0 ; hu_n = hu_0 ; hu_a = hu_0 ! 126 ; hv_b = hv_0 ; hv_n = hv_0 ; hv_a = hv_0 ! 127 ; r1_hu_b = z1_hu_0 ; r1_hu_n = z1_hu_0 ; r1_hu_a = z1_hu_0 ! inverse of water column thickness 128 ; r1_hv_b = z1_hv_0 ; r1_hv_n = z1_hv_0 ; r1_hv_a = z1_hv_0 ! 129 ! 130 CALL wrk_dealloc( jpi,jpj, z1_hu_0, z1_hv_0 ) 131 ! 132 ELSE ! time varying : initialize before/now/after variables 133 ! 134 CALL dom_vvl_init 135 ! 136 ENDIF 137 ! 138 CALL cfg_write ! create the configuration file 139 ! 140 ! IF( nn_timing == 1 ) CALL timing_stop('dom_init') 96 CALL cfg_write ! create the configuration file 97 ! 98 CALL dom_wri 141 99 ! 142 100 END SUBROUTINE dom_init 143 144 101 145 102 SUBROUTINE dom_nam -
NEMO/branches/2019/ENHANCE-03_domcfg/src/dombat.F90
r10727 r11129 1 1 MODULE dombat 2 2 3 USE oce ! ocean variables4 3 USE dom_oce ! ocean domain 5 4 ! USE closea ! closed seas … … 10 9 USE lib_mpp ! distributed memory computing library 11 10 USE wrk_nemo ! Memory allocation 12 USE timing ! Timing13 11 USE agrif_modutil 14 12 USE bilinear_interp -
NEMO/branches/2019/ENHANCE-03_domcfg/src/domcfg.f90
r10727 r11129 15 15 USE in_out_manager ! I/O manager 16 16 USE lib_mpp ! distributed memory computing library 17 USE timing ! Timing18 17 19 18 IMPLICIT NONE … … 36 35 !! 37 36 !!---------------------------------------------------------------------- 38 !39 ! IF( nn_timing == 1 ) CALL timing_start('dom_cfg')40 37 ! 41 38 IF(lwp) THEN ! Control print … … 60 57 CALL dom_glo ! global domain versus zoom and/or local domain 61 58 ! 62 ! IF( nn_timing == 1 ) CALL timing_stop('dom_cfg')63 !64 59 END SUBROUTINE dom_cfg 65 66 60 67 61 SUBROUTINE dom_glo … … 69 63 !! *** ROUTINE dom_glo *** 70 64 !! 71 !! ** Purpose : initialization for global domain, zoom and local domain65 !! ** Purpose : initialization of global domain <--> local domain indices 72 66 !! 73 67 !! ** Method : 74 68 !! 75 !! ** Action : - mig , mjg :76 !! - mi0 , mi1 :77 !! - mj0, , mj1 :69 !! ** Action : - mig , mjg : local domain indices ==> global domain indices 70 !! - mi0 , mi1 : global domain indices ==> local domain indices 71 !! - mj0,, mj1 (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 78 72 !!---------------------------------------------------------------------- 79 73 INTEGER :: ji, jj ! dummy loop argument 80 74 !!---------------------------------------------------------------------- 81 ! ! recalculate jpizoom/jpjzoom given lat/lon82 75 ! 83 ! ! ============== ! 84 ! ! Local domain ! 85 ! ! ============== ! 86 DO ji = 1, jpi ! local domain indices ==> data domain indices 87 mig(ji) = ji + jpizoom - 1 + nimpp - 1 76 DO ji = 1, jpi ! local domain indices ==> global domain indices 77 mig(ji) = ji + nimpp - 1 88 78 END DO 89 79 DO jj = 1, jpj 90 mjg(jj) = jj + jpjzoom - 1 +njmpp - 180 mjg(jj) = jj + njmpp - 1 91 81 END DO 92 ! 93 ! ! data domain indices ==> local domain indices 82 ! ! global domain indices ==> local domain indices 94 83 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 95 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.96 DO ji = 1, jpi dta97 mi0(ji) = MAX( 1 , MIN( ji - jpizoom + 1- nimpp + 1, jpi+1 ) )98 mi1(ji) = MAX( 0 , MIN( ji - jpizoom + 1- nimpp + 1, jpi ) )84 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 85 DO ji = 1, jpiglo 86 mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) ) 87 mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi ) ) 99 88 END DO 100 DO jj = 1, jpj dta101 mj0(jj) = MAX( 1 , MIN( jj - jpjzoom + 1- njmpp + 1, jpj+1 ) )102 mj1(jj) = MAX( 0 , MIN( jj - jpjzoom + 1- njmpp + 1, jpj ) )89 DO jj = 1, jpjglo 90 mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) ) 91 mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj ) ) 103 92 END DO 104 93 IF(lwp) THEN ! control print 105 94 WRITE(numout,*) 106 WRITE(numout,*) 'dom_glo : domain: data /local '95 WRITE(numout,*) 'dom_glo : domain: global <<==>> local ' 107 96 WRITE(numout,*) '~~~~~~~ ' 108 WRITE(numout,*) ' data input domain : jpidta = ', jpidta, & 109 & ' jpjdta = ', jpjdta, ' jpkdta = ', jpkdta 110 WRITE(numout,*) ' global or zoom domain: jpiglo = ', jpiglo, & 111 & ' jpjglo = ', jpjglo, ' jpk = ', jpk 112 WRITE(numout,*) ' local domain : jpi = ', jpi , & 113 & ' jpj = ', jpj , ' jpk = ', jpk 97 WRITE(numout,*) ' global domain: jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo 98 WRITE(numout,*) ' local domain: jpi = ', jpi , ' jpj = ', jpj , ' jpk = ', jpk 114 99 WRITE(numout,*) 115 WRITE(numout,*) ' south-west indices jpizoom = ', jpizoom, & 116 & ' jpjzoom = ', jpjzoom 100 WRITE(numout,*) ' conversion from local to global domain indices (and vise versa) done' 117 101 IF( nn_print >= 1 ) THEN 118 102 WRITE(numout,*) 119 WRITE(numout,*) ' conversion local ==> data i-index domain'103 WRITE(numout,*) ' conversion local ==> global i-index domain (mig)' 120 104 WRITE(numout,25) (mig(ji),ji = 1,jpi) 121 105 WRITE(numout,*) 122 WRITE(numout,*) ' conversion data==> local i-index domain'123 WRITE(numout,*) ' starting index '124 WRITE(numout,25) (mi0(ji),ji = 1,jpi dta)125 WRITE(numout,*) ' ending index '126 WRITE(numout,25) (mi1(ji),ji = 1,jpi dta)106 WRITE(numout,*) ' conversion global ==> local i-index domain' 107 WRITE(numout,*) ' starting index (mi0)' 108 WRITE(numout,25) (mi0(ji),ji = 1,jpiglo) 109 WRITE(numout,*) ' ending index (mi1)' 110 WRITE(numout,25) (mi1(ji),ji = 1,jpiglo) 127 111 WRITE(numout,*) 128 WRITE(numout,*) ' conversion local ==> data j-index domain'112 WRITE(numout,*) ' conversion local ==> global j-index domain (mjg)' 129 113 WRITE(numout,25) (mjg(jj),jj = 1,jpj) 130 114 WRITE(numout,*) 131 WRITE(numout,*) ' conversion data ==> localj-index domain'132 WRITE(numout,*) ' starting index '133 WRITE(numout,25) (mj0(jj),jj = 1,jpj dta)134 WRITE(numout,*) ' ending index '135 WRITE(numout,25) (mj1(jj),jj = 1,jpj dta)115 WRITE(numout,*) ' conversion global ==> local j-index domain' 116 WRITE(numout,*) ' starting index (mj0)' 117 WRITE(numout,25) (mj0(jj),jj = 1,jpjglo) 118 WRITE(numout,*) ' ending index (mj1)' 119 WRITE(numout,25) (mj1(jj),jj = 1,jpjglo) 136 120 ENDIF 137 121 ENDIF 138 122 25 FORMAT( 100(10x,19i4,/) ) 139 140 ! ! ============== !141 ! ! Zoom domain !142 ! ! ============== !143 ! ! zoom control144 IF( jpiglo + jpizoom - 1 > jpidta .OR. &145 jpjglo + jpjzoom - 1 > jpjdta ) &146 & CALL ctl_stop( ' global or zoom domain exceed the data domain ! ' )147 148 ! ! set zoom flag149 IF( jpiglo < jpidta .OR. jpjglo < jpjdta ) lzoom = .TRUE.150 151 ! ! set zoom type flags152 IF( lzoom .AND. jpizoom /= 1 ) lzoom_w = .TRUE. !153 IF( lzoom .AND. jpjzoom /= 1 ) lzoom_s = .TRUE.154 IF( lzoom .AND. jpiglo + jpizoom -1 /= jpidta ) lzoom_e = .TRUE.155 IF( lzoom .AND. jpjglo + jpjzoom -1 /= jpjdta ) lzoom_n = .TRUE.156 IF(lwp) THEN157 WRITE(numout,*)158 WRITE(numout,*) ' zoom flags : '159 WRITE(numout,*) ' lzoom = ', lzoom , ' (T = zoom, F = global )'160 WRITE(numout,*) ' lzoom_e = ', lzoom_e, ' (T = forced closed east boundary)'161 WRITE(numout,*) ' lzoom_w = ', lzoom_w, ' (T = forced closed west boundary)'162 WRITE(numout,*) ' lzoom_s = ', lzoom_s, ' (T = forced closed South boundary)'163 WRITE(numout,*) ' lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)'164 ENDIF165 IF( ( lzoom_e .OR. lzoom_w ) .AND. ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) ) &166 & CALL ctl_stop( ' Your zoom choice is inconsistent with east-west cyclic boundary condition' )167 IF( lzoom_n .AND. ( 3 <= jperio .AND. jperio <= 6 ) ) &168 & CALL ctl_stop( ' Your zoom choice is inconsistent with North fold boundary condition' )169 170 ! ! Pre-defined arctic/antarctic zoom of ORCA configuration flag171 IF( cp_cfg == "orca" ) THEN172 SELECT CASE ( jp_cfg )173 CASE ( 2 ) ! ORCA_R2 configuration174 IF( cp_cfz == "arctic" .AND. jpiglo == 142 .AND. jpjglo == 53 .AND. &175 & jpizoom == 21 .AND. jpjzoom == 97 ) THEN176 IF(lwp) WRITE(numout,*) ' ORCA configuration: arctic zoom '177 ENDIF178 IF( cp_cfz == "antarctic" .AND. jpiglo == jpidta .AND. jpjglo == 50 .AND. &179 & jpizoom == 1 .AND. jpjzoom == 1 ) THEN180 IF(lwp) WRITE(numout,*) ' ORCA configuration: antarctic zoom '181 ENDIF182 !183 CASE ( 05 ) ! ORCA_R05 configuration184 IF( cp_cfz == "arctic" .AND. jpiglo == 562 .AND. jpjglo == 202 .AND. &185 & jpizoom == 81 .AND. jpjzoom == 301 ) THEN186 IF(lwp) WRITE(numout,*) ' ORCA configuration: arctic zoom '187 ENDIF188 IF( cp_cfz == "antarctic" .AND. jpiglo == jpidta .AND. jpjglo == 187 .AND. &189 & jpizoom == 1 .AND. jpjzoom == 1 ) THEN190 IF(lwp) WRITE(numout,*) ' ORCA configuration: antarctic zoom '191 ENDIF192 END SELECT193 !194 ENDIF195 123 ! 196 124 END SUBROUTINE dom_glo 197 198 125 !!====================================================================== 199 126 END MODULE domcfg -
NEMO/branches/2019/ENHANCE-03_domcfg/src/domhgr.F90
r10727 r11129 111 111 INTEGER :: ie1e2u_v ! fag for u- & v-surface read in coordinate file or not 112 112 !!---------------------------------------------------------------------- 113 !114 ! IF( nn_timing == 1 ) CALL timing_start('dom_hgr')115 113 ! 116 114 IF(lwp) THEN … … 437 435 ! ------------------------------------------ 438 436 ! The equator line must be the latitude coordinate axe 439 440 ! IF( nperio == 2 ) THEN 441 ! znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi ) 442 ! IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' ) 443 ! ENDIF 444 ! 445 ! IF( nn_timing == 1 ) CALL timing_stop('dom_hgr') 437 ! (PM) be carefull with nperio/jperio 438 IF( jperio == 2 ) THEN 439 znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi ) 440 IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' ) 441 ENDIF 446 442 ! 447 443 END SUBROUTINE dom_hgr -
NEMO/branches/2019/ENHANCE-03_domcfg/src/dommsk.F90
r10727 r11129 9 9 !! - ! 1996-05 (G. Madec) mask computed from tmask 10 10 !! 8.0 ! 1997-02 (G. Madec) mesh information put in domhgr.F 11 !! 8.1 ! 1997-07 (G. Madec) modification of mbathyand fmask11 !! 8.1 ! 1997-07 (G. Madec) modification of kbat and fmask 12 12 !! - ! 1998-05 (G. Roullet) free surface 13 13 !! 8.2 ! 2000-03 (G. Madec) no slip accurate … … 17 17 !! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option 18 18 !! 3.6 ! 2015-05 (P. Mathiot) ISF: add wmask,wumask and wvmask 19 !!---------------------------------------------------------------------- 20 21 !!---------------------------------------------------------------------- 22 !! dom_msk : compute land/ocean mask 23 !!---------------------------------------------------------------------- 24 USE oce ! ocean dynamics and tracers 25 USE dom_oce ! ocean space and time domain 19 !! 4.0 ! 2016-06 (G. Madec, S. Flavoni) domain configuration / user defined interface 20 !!---------------------------------------------------------------------- 21 22 !!---------------------------------------------------------------------- 23 !! dom_msk : compute land/ocean mask 24 !!---------------------------------------------------------------------- 25 USE dom_oce ! ocean space and time domain 26 USE bdy_oce ! open boundary 26 27 ! 27 USE in_out_manager ! I/O manager 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 USE lib_mpp ! 30 USE wrk_nemo ! Memory allocation 31 USE timing ! Timing 28 USE in_out_manager ! I/O manager 29 USE iom ! IOM library 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 USE lib_mpp ! Massively Parallel Processing library 32 32 33 33 IMPLICIT NONE … … 42 42 43 43 !! * Substitutions 44 !!---------------------------------------------------------------------- 45 !! *** vectopt_loop_substitute *** 46 !!---------------------------------------------------------------------- 47 !! ** purpose : substitute the inner loop start/end indices with CPP macro 48 !! allow unrolling of do-loop (useful with vector processors) 49 !!---------------------------------------------------------------------- 50 !!---------------------------------------------------------------------- 51 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 52 !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 53 !! Software governed by the CeCILL licence (./LICENSE) 54 !!---------------------------------------------------------------------- 55 !!---------------------------------------------------------------------- 56 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 57 !! $Id: dommsk.F90 6140 2015-12-21 11:35:23Z timgraham $ 58 !! Software governed by the CeCILL licence (./LICENSE) 44 # include "vectopt_loop_substitute.h90" 45 !!---------------------------------------------------------------------- 46 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 47 !! $Id: dommsk.F90 10425 2018-12-19 21:54:16Z smasson $ 48 !! Software governed by the CeCILL license (see ./LICENSE) 59 49 !!---------------------------------------------------------------------- 60 50 CONTAINS … … 67 57 !! zontal velocity points (u & v), vorticity points (f) points. 68 58 !! 69 !! ** Method : The ocean/land mask is computed from the basin bathy- 70 !! metry in level (mbathy) which is defined or read in dommba. 71 !! mbathy equals 0 over continental T-point 72 !! and the number of ocean level over the ocean. 73 !! 74 !! At a given position (ji,jj,jk) the ocean/land mask is given by: 75 !! t-point : 0. IF mbathy( ji ,jj) =< 0 76 !! 1. IF mbathy( ji ,jj) >= jk 77 !! u-point : 0. IF mbathy( ji ,jj) or mbathy(ji+1, jj ) =< 0 78 !! 1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk. 79 !! v-point : 0. IF mbathy( ji ,jj) or mbathy( ji ,jj+1) =< 0 80 !! 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk. 81 !! f-point : 0. IF mbathy( ji ,jj) or mbathy( ji ,jj+1) 82 !! or mbathy(ji+1,jj) or mbathy(ji+1,jj+1) =< 0 83 !! 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) 84 !! and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. 85 !! tmask_i : interior ocean mask at t-point, i.e. excluding duplicated 86 !! rows/lines due to cyclic or North Fold boundaries as well 87 !! as MPP halos. 88 !! 89 !! The lateral friction is set through the value of fmask along 90 !! the coast and topography. This value is defined by rn_shlat, a 91 !! namelist parameter: 59 !! ** Method : The ocean/land mask at t-point is deduced from ko_top 60 !! and ko_bot, the indices of the fist and last ocean t-levels which 61 !! are either defined in usrdef_zgr or read in zgr_read. 62 !! The velocity masks (umask, vmask, wmask, wumask, wvmask) 63 !! are deduced from a product of the two neighboring tmask. 64 !! The vorticity mask (fmask) is deduced from tmask taking 65 !! into account the choice of lateral boundary condition (rn_shlat) : 92 66 !! rn_shlat = 0, free slip (no shear along the coast) 93 67 !! rn_shlat = 2, no slip (specified zero velocity at the coast) … … 95 69 !! 2 < rn_shlat, strong slip | in the lateral boundary layer 96 70 !! 97 !! N.B. If nperio not equal to 0, the land/ocean mask arrays98 !! are defined with the proper value at lateral domain boundaries.99 !! 100 !! In case of open boundaries (lk_bdy=T):101 !! - tmask is set to 1 on the points to be computed bay the open102 !! boundaries routines.103 !! 104 !! ** Action : tmask : land/ocean mask at t-point(=0. or 1.)105 !! umask : land/ocean mask at u-point (=0. or 1.)106 !! vmask : land/ocean mask at v-point (=0. or 1.)107 !! fmask : land/ocean mask at f-point (=0. or 1.)108 !! =rn_shlat along lateral boundaries109 !! tmask_i : interiorocean mask71 !! tmask_i : interior ocean mask at t-point, i.e. excluding duplicated 72 !! rows/lines due to cyclic or North Fold boundaries as well 73 !! as MPP halos. 74 !! tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines 75 !! due to cyclic or North Fold boundaries as well as MPP halos. 76 !! 77 !! ** Action : tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask 78 !! at t-, u-, v- w, wu-, and wv-points (=0. or 1.) 79 !! fmask : land/ocean mask at f-point (=0., or =1., or 80 !! =rn_shlat along lateral boundaries) 81 !! tmask_i : interior ocean mask 82 !! tmask_h : halo mask 83 !! ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask 110 84 !!---------------------------------------------------------------------- 111 INTEGER :: ji, jj, jk ! dummy loop indices112 INTEGER :: iif, iil, ii0, ii1, ii ! local integers113 INTEGER :: i jf, ijl, ij0, ij1 ! - -114 INTEGER :: i os115 INTEGER :: i srow ! index for ORCA1 starting row116 INTEGER , POINTER, DIMENSION(:,:) :: imsk117 REAL(wp), POINTER, DIMENSION(:,:) :: zwf85 ! 86 INTEGER :: ji, jj, jk ! dummy loop indices 87 INTEGER :: iif, iil ! local integers 88 INTEGER :: ijf, ijl ! - - 89 INTEGER :: iktop, ikbot ! - - 90 INTEGER :: ios, inum 91 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zwf ! 2D workspace 118 92 !! 119 93 NAMELIST/namlbc/ rn_shlat, ln_vorlat 94 NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file, & 95 & ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, & 96 & cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, & 97 & ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 98 & cn_ice, nn_ice_dta, & 99 & rn_ice_tem, rn_ice_sal, rn_ice_age, & 100 & ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy 120 101 !!--------------------------------------------------------------------- 121 !122 ! IF( nn_timing == 1 ) CALL timing_start('dom_msk')123 !124 CALL wrk_alloc( jpi, jpj, imsk )125 CALL wrk_alloc( jpi, jpj, zwf )126 102 ! 127 103 REWIND( numnam_ref ) ! Namelist namlbc in reference namelist : Lateral momentum boundary condition 128 104 READ ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 ) 129 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp ) 130 105 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp ) 131 106 REWIND( numnam_cfg ) ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition 132 107 READ ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 ) 133 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp )108 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp ) 134 109 IF(lwm) WRITE ( numond, namlbc ) 135 110 … … 142 117 WRITE(numout,*) ' consistency with analytical form ln_vorlat = ',ln_vorlat 143 118 ENDIF 144 145 IF ( rn_shlat == 0. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral free-slip ' 146 ELSEIF ( rn_shlat == 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral no-slip ' 147 ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral partial-slip ' 148 ELSEIF ( 2. < rn_shlat ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral strong-slip ' 119 ! 120 IF(lwp) WRITE(numout,*) 121 IF ( rn_shlat == 0. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral free-slip' 122 ELSEIF ( rn_shlat == 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral no-slip' 123 ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral partial-slip' 124 ELSEIF ( 2. < rn_shlat ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral strong-slip' 149 125 ELSE 150 WRITE(ctmp1,*) ' rn_shlat is negative = ', rn_shlat 151 CALL ctl_stop( ctmp1 ) 152 ENDIF 153 154 ! 1. Ocean/land mask at t-point (computed from mbathy) 155 ! ----------------------------- 156 ! N.B. tmask has already the right boundary conditions since mbathy is ok 157 ! 126 CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' ) 127 ENDIF 128 129 ! 1. Ocean/land mask at t-point (computed from mbathy) 130 ! ----------------------------- 131 ! N.B. tmask has already the right boundary conditions since mbathy is ok 132 ! 158 133 tmask(:,:,:) = 0._wp 159 134 DO jk = 1, jpk 160 135 DO jj = 1, jpj 161 136 DO ji = 1, jpi 162 IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp ) tmask(ji,jj,jk) = 1._wp 163 END DO 164 END DO 165 END DO 166 167 ! (ISF) define barotropic mask and mask the ice shelf point 168 ssmask(:,:)=tmask(:,:,1) ! at this stage ice shelf is not masked 169 170 DO jk = 1, jpk 171 DO jj = 1, jpj 172 DO ji = 1, jpi 173 IF( REAL( misfdep(ji,jj) - jk, wp ) - 0.1_wp >= 0._wp ) THEN 174 tmask(ji,jj,jk) = 0._wp 175 END IF 176 END DO 177 END DO 178 END DO 179 180 ! Interior domain mask (used for global sum) 181 ! -------------------- 182 ! tmask_i(:,:) = ssmask(:,:) ! (ISH) tmask_i = 1 even on the ice shelf 183 184 ! tmask_h(:,:) = 1._wp ! 0 on the halo and 1 elsewhere 185 ! iif = jpreci ! ??? 186 ! iil = nlci - jpreci + 1 187 ! ijf = jprecj ! ??? 188 ! ijl = nlcj - jprecj + 1 189 190 ! tmask_h( 1 :iif, : ) = 0._wp ! first columns 191 ! tmask_h(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns) 192 ! tmask_h( : , 1 :ijf) = 0._wp ! first rows 193 ! tmask_h( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows) 194 195 ! north fold mask 196 ! --------------- 197 ! tpol(1:jpiglo) = 1._wp 198 ! fpol(1:jpiglo) = 1._wp 199 ! IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot 200 ! tpol(jpiglo/2+1:jpiglo) = 0._wp 201 ! fpol( 1 :jpiglo) = 0._wp 202 ! IF( mjg(nlej) == jpjglo ) THEN ! only half of the nlcj-1 row 203 ! DO ji = iif+1, iil-1 204 ! tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 205 ! END DO 206 ! ENDIF 207 ! ENDIF 137 IF( ( REAL( mbathy (ji,jj) - jk, wp ) + 0.1_wp >= 0._wp ) & 138 & .AND. ( REAL( misfdep(ji,jj) - jk, wp ) - 0.1_wp <= 0._wp ) ) THEN 139 tmask(ji,jj,jk) = 1._wp 140 END IF 141 END DO 142 END DO 143 END DO 208 144 209 ! tmask_i(:,:) = tmask_i(:,:) * tmask_h(:,:) 210 211 ! IF( jperio == 5 .OR. jperio == 6 ) THEN ! F-point pivot 212 ! tpol( 1 :jpiglo) = 0._wp 213 ! fpol(jpiglo/2+1:jpiglo) = 0._wp 214 ! ENDIF 215 216 ! 2. Ocean/land mask at u-, v-, and z-points (computed from tmask) 217 ! ------------------------------------------- 145 !SF add here lbc_lnk: bug not still understood : cause now domain configuration is read ! 146 !!gm I don't understand why... 147 CALL lbc_lnk( 'dommsk', tmask , 'T', 1._wp ) ! Lateral boundary conditions 148 149 ! Mask corrections for bdy (read in mppini2) 150 REWIND( numnam_ref ) ! Namelist nambdy in reference namelist :Unstructured open boundaries 151 READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 152 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 153 REWIND( numnam_cfg ) ! Namelist nambdy in configuration namelist :Unstructured open boundaries 154 READ ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 ) 155 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 156 ! ------------------------ 157 IF ( ln_bdy .AND. ln_mask_file ) THEN 158 CALL iom_open( cn_mask_file, inum ) 159 CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) ) 160 CALL iom_close( inum ) 161 DO jk = 1, jpkm1 162 DO jj = 1, jpj 163 DO ji = 1, jpi 164 tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj) 165 END DO 166 END DO 167 END DO 168 ENDIF 169 170 ! Ocean/land mask at u-, v-, and f-points (computed from tmask) 171 ! ---------------------------------------- 172 ! NB: at this point, fmask is designed for free slip lateral boundary condition 218 173 DO jk = 1, jpk 219 174 DO jj = 1, jpjm1 220 DO ji = 1, jpim1 ! vector loop175 DO ji = 1, fs_jpim1 ! vector loop 221 176 umask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji+1,jj ,jk) 222 177 vmask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji ,jj+1,jk) … … 228 183 END DO 229 184 END DO 230 ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point 231 ! DO jj = 1, jpjm1 232 ! DO ji = 1, jpim1 ! vector loop 233 ! ssumask(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:))) 234 ! ssvmask(ji,jj) = ssmask(ji,jj) * ssmask(ji ,jj+1) * MIN(1._wp,SUM(vmask(ji,jj,:))) 235 !! END DO 236 ! DO ji = 1, jpim1 ! NO vector opt. 237 ! ssfmask(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) & 238 ! & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 239 ! END DO 240 ! END DO 241 CALL lbc_lnk( 'toto',umask , 'U', 1._wp ) ! Lateral boundary conditions 242 CALL lbc_lnk( 'toto',vmask , 'V', 1._wp ) 243 CALL lbc_lnk( 'toto',fmask , 'F', 1._wp ) 244 ! CALL lbc_lnk( 'toto',ssumask, 'U', 1._wp ) ! Lateral boundary conditions 245 ! CALL lbc_lnk( 'toto',ssvmask, 'V', 1._wp ) 246 ! CALL lbc_lnk( 'toto',ssfmask, 'F', 1._wp ) 247 248 ! 3. Ocean/land mask at wu-, wv- and w points 249 !---------------------------------------------- 185 CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. ) ! Lateral boundary conditions 186 187 ! Ocean/land mask at wu-, wv- and w points (computed from tmask) 188 !----------------------------------------- 250 189 wmask (:,:,1) = tmask(:,:,1) ! surface 251 190 wumask(:,:,1) = umask(:,:,1) … … 257 196 END DO 258 197 198 199 ! Ocean/land column mask at t-, u-, and v-points (i.e. at least 1 wet cell in the vertical) 200 ! ---------------------------------------------- 201 ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 ) 202 ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 ) 203 ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 204 205 206 ! Interior domain mask (used for global sum) 207 ! -------------------- 208 ! 209 iif = nn_hls ; iil = nlci - nn_hls + 1 210 ijf = nn_hls ; ijl = nlcj - nn_hls + 1 211 ! 212 ! ! halo mask : 0 on the halo and 1 elsewhere 213 tmask_h(:,:) = 1._wp 214 tmask_h( 1 :iif, : ) = 0._wp ! first columns 215 tmask_h(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns) 216 tmask_h( : , 1 :ijf) = 0._wp ! first rows 217 tmask_h( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows) 218 ! 219 ! ! north fold mask 220 tpol(1:jpiglo) = 1._wp 221 fpol(1:jpiglo) = 1._wp 222 IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot 223 tpol(jpiglo/2+1:jpiglo) = 0._wp 224 fpol( 1 :jpiglo) = 0._wp 225 IF( mjg(nlej) == jpjglo ) THEN ! only half of the nlcj-1 row for tmask_h 226 DO ji = iif+1, iil-1 227 tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 228 END DO 229 ENDIF 230 ENDIF 231 ! 232 IF( jperio == 5 .OR. jperio == 6 ) THEN ! F-point pivot 233 tpol( 1 :jpiglo) = 0._wp 234 fpol(jpiglo/2+1:jpiglo) = 0._wp 235 ENDIF 236 ! 237 ! ! interior mask : 2D ocean mask x halo mask 238 tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 239 240 259 241 ! Lateral boundary conditions on velocity (modify fmask) 260 ! --------------------------------------- 261 DO jk = 1, jpk 262 zwf(:,:) = fmask(:,:,jk) 263 DO jj = 2, jpjm1 264 DO ji = 2, jpim1 ! vector opt. 265 IF( fmask(ji,jj,jk) == 0._wp ) THEN 266 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 267 & zwf(ji-1,jj), zwf(ji,jj-1) ) ) 268 ENDIF 269 END DO 270 END DO 271 DO jj = 2, jpjm1 272 IF( fmask(1,jj,jk) == 0._wp ) THEN 273 fmask(1 ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 274 ENDIF 275 IF( fmask(jpi,jj,jk) == 0._wp ) THEN 276 fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 277 ENDIF 278 END DO 279 DO ji = 2, jpim1 280 IF( fmask(ji,1,jk) == 0._wp ) THEN 281 fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 282 ENDIF 283 IF( fmask(ji,jpj,jk) == 0._wp ) THEN 284 fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 285 ENDIF 286 END DO 287 END DO 288 ! 289 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA_R2 configuration 290 ! ! Increased lateral friction near of some straits 291 ! ! Gibraltar strait : partial slip (fmask=0.5) 292 ij0 = 101 ; ij1 = 101 293 ii0 = 139 ; ii1 = 140 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 294 ij0 = 102 ; ij1 = 102 295 ii0 = 139 ; ii1 = 140 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 296 ! 297 ! ! Bab el Mandeb : partial slip (fmask=1) 298 ij0 = 87 ; ij1 = 88 299 ii0 = 160 ; ii1 = 160 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 300 ij0 = 88 ; ij1 = 88 301 ii0 = 159 ; ii1 = 159 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 302 ! 303 ! ! Danish straits : strong slip (fmask > 2) 304 ! We keep this as an example but it is instable in this case 305 ! ij0 = 115 ; ij1 = 115 306 ! ii0 = 145 ; ii1 = 146 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 307 ! ij0 = 116 ; ij1 = 116 308 ! ii0 = 145 ; ii1 = 146 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 309 ! 310 ENDIF 311 ! 312 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration 313 ! ! Increased lateral friction near of some straits 314 ! This dirty section will be suppressed by simplification process: 315 ! all this will come back in input files 316 ! Currently these hard-wired indices relate to configuration with 317 ! extend grid (jpjglo=332) 318 ! 319 isrow = 332 - jpjglo 320 ! 321 IF(lwp) WRITE(numout,*) 322 IF(lwp) WRITE(numout,*) ' orca_r1: increase friction near the following straits : ' 323 IF(lwp) WRITE(numout,*) ' Gibraltar ' 324 ii0 = 282 ; ii1 = 283 ! Gibraltar Strait 325 ij0 = 241 - isrow ; ij1 = 241 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 326 327 IF(lwp) WRITE(numout,*) ' Bhosporus ' 328 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait 329 ij0 = 248 - isrow ; ij1 = 248 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 330 331 IF(lwp) WRITE(numout,*) ' Makassar (Top) ' 332 ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top) 333 ij0 = 189 - isrow ; ij1 = 190 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 334 335 IF(lwp) WRITE(numout,*) ' Lombok ' 336 ii0 = 44 ; ii1 = 44 ! Lombok Strait 337 ij0 = 164 - isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 338 339 IF(lwp) WRITE(numout,*) ' Ombai ' 340 ii0 = 53 ; ii1 = 53 ! Ombai Strait 341 ij0 = 164 - isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 342 343 IF(lwp) WRITE(numout,*) ' Timor Passage ' 344 ii0 = 56 ; ii1 = 56 ! Timor Passage 345 ij0 = 164 - isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 346 347 IF(lwp) WRITE(numout,*) ' West Halmahera ' 348 ii0 = 58 ; ii1 = 58 ! West Halmahera Strait 349 ij0 = 181 - isrow ; ij1 = 182 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 350 351 IF(lwp) WRITE(numout,*) ' East Halmahera ' 352 ii0 = 55 ; ii1 = 55 ! East Halmahera Strait 353 ij0 = 181 - isrow ; ij1 = 182 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 354 ! 355 ENDIF 356 ! 357 CALL lbc_lnk( 'toto',fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 358 ! 359 ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) 360 ! 361 CALL wrk_dealloc( jpi, jpj, imsk ) 362 CALL wrk_dealloc( jpi, jpj, zwf ) 363 ! 364 ! IF( nn_timing == 1 ) CALL timing_stop('dom_msk') 242 ! --------------------------------------- 243 IF( rn_shlat /= 0 ) THEN ! Not free-slip lateral boundary condition 244 ! 245 ALLOCATE( zwf(jpi,jpj) ) 246 ! 247 DO jk = 1, jpk 248 zwf(:,:) = fmask(:,:,jk) 249 DO jj = 2, jpjm1 250 DO ji = fs_2, fs_jpim1 ! vector opt. 251 IF( fmask(ji,jj,jk) == 0._wp ) THEN 252 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 253 & zwf(ji-1,jj), zwf(ji,jj-1) ) ) 254 ENDIF 255 END DO 256 END DO 257 DO jj = 2, jpjm1 258 IF( fmask(1,jj,jk) == 0._wp ) THEN 259 fmask(1 ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 260 ENDIF 261 IF( fmask(jpi,jj,jk) == 0._wp ) THEN 262 fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 263 ENDIF 264 END DO 265 DO ji = 2, jpim1 266 IF( fmask(ji,1,jk) == 0._wp ) THEN 267 fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 268 ENDIF 269 IF( fmask(ji,jpj,jk) == 0._wp ) THEN 270 fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 271 ENDIF 272 END DO 273 #if defined key_agrif 274 IF( .NOT. AGRIF_Root() ) THEN 275 IF ((nbondi == 1).OR.(nbondi == 2)) fmask(nlci-1 , : ,jk) = 0.e0 ! east 276 IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1 , : ,jk) = 0.e0 ! west 277 IF ((nbondj == 1).OR.(nbondj == 2)) fmask(: ,nlcj-1 ,jk) = 0.e0 ! north 278 IF ((nbondj == -1).OR.(nbondj == 2)) fmask(: ,1 ,jk) = 0.e0 ! south 279 ENDIF 280 #endif 281 END DO 282 ! 283 DEALLOCATE( zwf ) 284 ! 285 CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 286 ! 287 ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat 288 ! 289 ENDIF 365 290 ! 366 291 END SUBROUTINE dom_msk -
NEMO/branches/2019/ENHANCE-03_domcfg/src/domzgr.F90
r10727 r11129 35 35 !! fgamma : Siddorn and Furner 2012 stretching function 36 36 !!--------------------------------------------------------------------- 37 USE oce ! ocean variables38 37 USE dom_oce ! ocean domain 39 38 ! USE closea ! closed seas … … 43 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 44 43 USE lib_mpp ! distributed memory computing library 45 USE wrk_nemo ! Memory allocation 46 USE timing ! Timing 44 USE lib_fortran 47 45 USE dombat 48 46 … … 63 61 REAL(wp), PUBLIC :: e3zps_min !: miminum thickness for partial steps (meters) 64 62 REAL(wp), PUBLIC :: e3zps_rat !: minimum thickness ration for partial steps 65 INTEGER, PUBLIC :: nperio!: type of lateral boundary condition63 INTEGER, PUBLIC :: nperio !: type of lateral boundary condition 66 64 67 65 ! Song and Haidvogel 1994 stretching parameters … … 121 119 !!---------------------------------------------------------------------- 122 120 ! 123 ! IF( nn_timing == 1 ) CALL timing_start('dom_zgr')124 121 ! 125 122 REWIND( numnam_ref ) ! Namelist namzgr in reference namelist : Vertical coordinate … … 189 186 ENDIF 190 187 ! 191 ! IF( nn_timing == 1 ) CALL timing_stop('dom_zgr')192 !193 188 END SUBROUTINE dom_zgr 194 189 … … 222 217 REAL(wp) :: za2, zkth2, zacr2 ! Values for optional double tanh function set from parameters 223 218 !!---------------------------------------------------------------------- 224 !225 ! IF( nn_timing == 1 ) CALL timing_start('zgr_z')226 219 ! 227 220 ! Set variables from parameters … … 355 348 END DO 356 349 ! 357 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_z')358 !359 350 END SUBROUTINE zgr_z 360 351 … … 401 392 !!---------------------------------------------------------------------- 402 393 ! 403 ! IF( nn_timing == 1 ) CALL timing_start('zgr_bat')404 !405 394 IF(lwp) WRITE(numout,*) 406 395 IF(lwp) WRITE(numout,*) ' zgr_bat : defines level and meter bathymetry' … … 411 400 ! ! global domain level and meter bathymetry (idta,zdta) 412 401 ! 413 ALLOCATE( idta(jpi dta,jpjdta), STAT=ierror )402 ALLOCATE( idta(jpiglo,jpjglo), STAT=ierror ) 414 403 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate idta array' ) 415 ALLOCATE( zdta(jpi dta,jpjdta), STAT=ierror )404 ALLOCATE( zdta(jpiglo,jpjglo), STAT=ierror ) 416 405 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate zdta array' ) 417 406 ! … … 439 428 IF(lwp) WRITE(numout,*) 440 429 IF(lwp) WRITE(numout,*) ' bathymetry field: flat basin with a bump' 441 ii_bump = jpi dta/ 2 ! i-index of the bump center442 ij_bump = jpj dta/ 2 ! j-index of the bump center430 ii_bump = jpiglo / 2 ! i-index of the bump center 431 ij_bump = jpjglo / 2 ! j-index of the bump center 443 432 r_bump = 50000._wp ! bump radius (meters) 444 433 h_bump = 2700._wp ! bump height (meters) … … 450 439 IF(lwp) WRITE(numout,*) ' background ocean depth = ', h_oce , ' meters' 451 440 ! 452 DO jj = 1, jpj dta! zdta :453 DO ji = 1, jpi dta441 DO jj = 1, jpjglo ! zdta : 442 DO ji = 1, jpiglo 454 443 zi = FLOAT( ji - ii_bump ) * ppe1_m / r_bump 455 444 zj = FLOAT( jj - ij_bump ) * ppe2_m / r_bump … … 467 456 ENDIF 468 457 ENDIF 458 ! 469 459 ! ! set GLOBAL boundary conditions 470 ! ! Caution : idta on the global domain: use of jperio, not nperio471 460 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 472 461 idta( : , 1 ) = -1 ; zdta( : , 1 ) = -1._wp 473 idta( : ,jpj dta) = 0 ; zdta( : ,jpjdta) = 0._wp462 idta( : ,jpjglo) = 0 ; zdta( : ,jpjglo) = 0._wp 474 463 ELSEIF( jperio == 2 ) THEN 475 464 idta( : , 1 ) = idta( : , 3 ) ; zdta( : , 1 ) = zdta( : , 3 ) 476 idta( : ,jpj dta) = 0 ; zdta( : ,jpjdta) = 0._wp465 idta( : ,jpjglo) = 0 ; zdta( : ,jpjglo) = 0._wp 477 466 idta( 1 , : ) = 0 ; zdta( 1 , : ) = 0._wp 478 idta(jpi dta, : ) = 0 ; zdta(jpidta, : ) = 0._wp467 idta(jpiglo, : ) = 0 ; zdta(jpiglo, : ) = 0._wp 479 468 ELSE 480 469 ih = 0 ; zh = 0._wp 481 470 IF( ln_sco ) ih = jpkm1 ; IF( ln_sco ) zh = h_oce 482 471 idta( : , 1 ) = ih ; zdta( : , 1 ) = zh 483 idta( : ,jpj dta) = ih ; zdta( : ,jpjdta) = zh472 idta( : ,jpjglo) = ih ; zdta( : ,jpjglo) = zh 484 473 idta( 1 , : ) = ih ; zdta( 1 , : ) = zh 485 idta(jpi dta, : ) = ih ; zdta(jpidta, : ) = zh474 idta(jpiglo, : ) = ih ; zdta(jpiglo, : ) = zh 486 475 ENDIF 487 476 … … 646 635 ENDIF 647 636 ! 648 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_bat')649 !650 637 END SUBROUTINE zgr_bat 651 638 … … 727 714 INTEGER :: ji, jj, jl ! dummy loop indices 728 715 INTEGER :: icompt, ibtest, ikmax ! temporary integers 729 REAL(wp), POINTER, DIMENSION(:,:) :: zbathy 730 !!---------------------------------------------------------------------- 731 ! 732 ! IF( nn_timing == 1 ) CALL timing_start('zgr_bat_ctl') 733 ! 734 CALL wrk_alloc( jpi, jpj, zbathy ) 716 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zbathy 717 !!---------------------------------------------------------------------- 718 ! 719 ALLOCATE(zbathy(jpi,jpj)) 735 720 ! 736 721 IF(lwp) WRITE(numout,*) … … 743 728 icompt = 0 744 729 DO jl = 1, 2 745 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN730 IF( l_Iperio ) THEN 746 731 mbathy( 1 ,:) = mbathy(jpim1,:) ! local domain is cyclic east-west 747 732 mbathy(jpi,:) = mbathy( 2 ,:) 748 733 ENDIF 734 zbathy(:,:) = FLOAT( mbathy(:,:) ) 735 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp ) 736 mbathy(:,:) = INT( zbathy(:,:) ) 737 749 738 DO jj = 2, jpjm1 750 739 DO ji = 2, jpim1 … … 760 749 END DO 761 750 END DO 762 ! IF( lk_mpp ) CALL mpp_sum( icompt ) 751 752 IF( lk_mpp ) CALL mpp_sum( 'domzgr', icompt ) 763 753 IF( icompt == 0 ) THEN 764 754 IF(lwp) WRITE(numout,*)' no isolated ocean grid points' … … 766 756 IF(lwp) WRITE(numout,*)' ',icompt,' ocean grid points suppressed' 767 757 ENDIF 768 IF( lk_mpp ) THEN 769 770 CALL lbc_lnk( 'toto',zbathy, 'T', 1._wp )771 772 ENDIF 758 759 zbathy(:,:) = FLOAT( mbathy(:,:) ) 760 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp ) 761 mbathy(:,:) = INT( zbathy(:,:) ) 762 773 763 ! ! East-west cyclic boundary conditions 774 IF( nperio == 0 ) THEN775 IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: nperio = ', nperio764 IF( jperio == 0 ) THEN 765 IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: jperio = ', jperio 776 766 IF( lk_mpp ) THEN 777 767 IF( nbondi == -1 .OR. nbondi == 2 ) THEN … … 790 780 ENDIF 791 781 ENDIF 792 ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN793 IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: nperio = ', nperio782 ELSEIF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 783 IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: jperio = ', jperio 794 784 mbathy( 1 ,:) = mbathy(jpim1,:) 795 785 mbathy(jpi,:) = mbathy( 2 ,:) 796 ELSEIF( nperio == 2 ) THEN797 IF(lwp) WRITE(numout,*) ' equatorial boundary conditions on mbathy: nperio = ', nperio786 ELSEIF( jperio == 2 ) THEN 787 IF(lwp) WRITE(numout,*) ' equatorial boundary conditions on mbathy: jperio = ', jperio 798 788 ELSE 799 789 IF(lwp) WRITE(numout,*) ' e r r o r' 800 IF(lwp) WRITE(numout,*) ' parameter , nperio = ', nperio790 IF(lwp) WRITE(numout,*) ' parameter , jperio = ', jperio 801 791 ! STOP 'dom_mba' 802 792 ENDIF 793 803 794 ! Boundary condition on mbathy 804 795 IF( .NOT.lk_mpp ) THEN … … 806 797 ! ... mono- or macro-tasking: T-point, >0, 2D array, no slab 807 798 zbathy(:,:) = FLOAT( mbathy(:,:) ) 808 CALL lbc_lnk( ' toto',zbathy, 'T', 1._wp )799 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp ) 809 800 mbathy(:,:) = INT( zbathy(:,:) ) 810 801 ENDIF 802 811 803 ! Number of ocean level inferior or equal to jpkm1 812 ikmax = 0 813 DO jj = 1, jpj 814 DO ji = 1, jpi 815 ikmax = MAX( ikmax, mbathy(ji,jj) ) 816 END DO 817 END DO 818 !!gm !!! test to do: ikmax = MAX( mbathy(:,:) ) ??? 804 zbathy(:,:) = FLOAT( mbathy(:,:) ) 805 ikmax = glob_max( 'domzgr', zbathy(:,:) ) 806 819 807 IF( ikmax > jpkm1 ) THEN 820 808 IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' > jpk-1' … … 825 813 ENDIF 826 814 ! 827 CALL wrk_dealloc( jpi, jpj, zbathy ) 828 ! 829 !! IF( nn_timing == 1 ) CALL timing_stop('zgr_bat_ctl') 815 DEALLOCATE( zbathy ) 830 816 ! 831 817 END SUBROUTINE zgr_bat_ctl … … 845 831 !!---------------------------------------------------------------------- 846 832 INTEGER :: ji, jj ! dummy loop indices 847 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 848 !!---------------------------------------------------------------------- 849 ! 850 ! IF( nn_timing == 1 ) CALL timing_start('zgr_bot_level') 851 ! 852 CALL wrk_alloc( jpi, jpj, zmbk ) 833 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zmbk 834 !!---------------------------------------------------------------------- 835 ! 836 ALLOCATE( zmbk(jpi,jpj) ) 853 837 ! 854 838 IF(lwp) WRITE(numout,*) … … 866 850 END DO 867 851 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 868 zmbk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk('toto',zmbk,'U',1.) ; mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 869 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk('toto',zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 870 ! 871 CALL wrk_dealloc( jpi, jpj, zmbk ) 872 ! 873 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_bot_level') 852 zmbk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk('domzgr',zmbk,'U',1.) ; mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 853 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk('domzgr',zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 854 ! 855 DEALLOCATE( zmbk ) 874 856 ! 875 857 END SUBROUTINE zgr_bot_level … … 889 871 !!---------------------------------------------------------------------- 890 872 INTEGER :: ji, jj ! dummy loop indices 891 REAL(wp), POINTER, DIMENSION(:,:) :: zmik 892 !!---------------------------------------------------------------------- 893 ! 894 ! IF( nn_timing == 1 ) CALL timing_start('zgr_top_level') 895 ! 896 CALL wrk_alloc( jpi, jpj, zmik ) 873 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zmik 874 !!---------------------------------------------------------------------- 875 ! 876 ALLOCATE( zmik(jpi,jpj) ) 897 877 ! 898 878 IF(lwp) WRITE(numout,*) … … 911 891 912 892 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 913 zmik(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk('toto',zmik,'U',1.) ; miku (:,:) = MAX( INT( zmik(:,:) ), 1 ) 914 zmik(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk('toto',zmik,'V',1.) ; mikv (:,:) = MAX( INT( zmik(:,:) ), 1 ) 915 zmik(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk('toto',zmik,'F',1.) ; mikf (:,:) = MAX( INT( zmik(:,:) ), 1 ) 916 ! 917 CALL wrk_dealloc( jpi, jpj, zmik ) 918 ! 919 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_top_level') 893 zmik(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk('domzgr',zmik,'U',1.) ; miku (:,:) = MAX( INT( zmik(:,:) ), 1 ) 894 zmik(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk('domzgr',zmik,'V',1.) ; mikv (:,:) = MAX( INT( zmik(:,:) ), 1 ) 895 zmik(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk('domzgr',zmik,'F',1.) ; mikf (:,:) = MAX( INT( zmik(:,:) ), 1 ) 896 ! 897 DEALLOCATE( zmik ) 920 898 ! 921 899 END SUBROUTINE zgr_top_level … … 932 910 INTEGER :: jk 933 911 !!---------------------------------------------------------------------- 934 !935 ! IF( nn_timing == 1 ) CALL timing_start('zgr_zco')936 912 ! 937 913 DO jk = 1, jpk … … 948 924 END DO 949 925 ! 950 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_zco')951 !952 926 END SUBROUTINE zgr_zco 953 927 … … 1004 978 REAL(wp) :: zdiff ! temporary scalar 1005 979 REAL(wp) :: zmax ! temporary scalar 1006 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprt980 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zprt 1007 981 !!--------------------------------------------------------------------- 1008 982 ! 1009 ! IF( nn_timing == 1 ) CALL timing_start('zgr_zps') 1010 ! 1011 CALL wrk_alloc( jpi,jpj,jpk, zprt ) 983 ALLOCATE( zprt(jpi,jpj,jpk) ) 1012 984 ! 1013 985 IF(lwp) WRITE(numout,*) … … 1140 1112 END IF 1141 1113 1142 CALL lbc_lnk(' toto', e3u_0 , 'U', 1._wp ) ; CALL lbc_lnk('toto', e3uw_0, 'U', 1._wp ) ! lateral boundary conditions1143 CALL lbc_lnk( 'toto',e3v_0 , 'V', 1._wp ) ; CALL lbc_lnk('toto', e3vw_0, 'V', 1._wp )1114 CALL lbc_lnk('domzgr', e3u_0 , 'U', 1._wp ) ; CALL lbc_lnk('domzgr', e3uw_0, 'U', 1._wp ) ! lateral boundary conditions 1115 CALL lbc_lnk('domzgr', e3v_0 , 'V', 1._wp ) ; CALL lbc_lnk('domzgr', e3vw_0, 'V', 1._wp ) 1144 1116 ! 1145 1117 … … 1162 1134 END DO 1163 1135 END DO 1164 CALL lbc_lnk(' toto', e3f_0, 'F', 1._wp ) ! Lateral boundary conditions1136 CALL lbc_lnk('domzgr', e3f_0, 'F', 1._wp ) ! Lateral boundary conditions 1165 1137 ! 1166 1138 DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries) … … 1203 1175 END IF 1204 1176 ! 1205 CALL wrk_dealloc( jpi,jpj,jpk, zprt ) 1206 ! 1207 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_zps') 1177 DEALLOCATE( zprt ) 1208 1178 ! 1209 1179 END SUBROUTINE zgr_zps … … 1235 1205 REAL(wp) :: zdepwp ! Ajusted ocean depth to avoid too small e3t 1236 1206 REAL(wp) :: zdiff ! temporary scalar 1237 REAL(wp), POINTER, DIMENSION(:,:) :: zrisfdep, zbathy, zmask ! 2D workspace (ISH)1238 INTEGER , POINTER, DIMENSION(:,:) :: zmbathy, zmisfdep ! 2D workspace (ISH)1207 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zrisfdep, zbathy, zmask ! 2D workspace (ISH) 1208 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: zmbathy, zmisfdep ! 2D workspace (ISH) 1239 1209 !!--------------------------------------------------------------------- 1240 1210 ! 1241 !! IF( nn_timing == 1 ) CALL timing_start('zgr_isf') 1242 ! 1243 CALL wrk_alloc( jpi,jpj, zbathy, zmask, zrisfdep) 1244 CALL wrk_alloc( jpi,jpj, zmisfdep, zmbathy ) 1245 1211 ALLOCATE( zbathy(jpi,jpj), zmask(jpi,jpj), zrisfdep(jpi,jpj) ) 1212 ALLOCATE( zmisfdep(jpi,jpj), zmbathy(jpi,jpj) ) 1213 ! 1246 1214 ! (ISF) compute misfdep 1247 1215 WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) /= 0 ) ; misfdep(:,:) = 1 ! open water : set misfdep to 1 … … 1286 1254 IF( lk_mpp ) THEN 1287 1255 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1288 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1256 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1289 1257 misfdep(:,:) = INT( zbathy(:,:) ) 1290 1258 1291 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1292 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1259 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1260 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1293 1261 1294 1262 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1295 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1263 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1296 1264 mbathy(:,:) = INT( zbathy(:,:) ) 1297 1265 ENDIF … … 1407 1375 IF( lk_mpp ) THEN 1408 1376 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1409 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1377 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1410 1378 misfdep(:,:) = INT( zbathy(:,:) ) 1411 1379 1412 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1413 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1380 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1381 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1414 1382 1415 1383 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1416 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1384 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1417 1385 mbathy(:,:) = INT( zbathy(:,:) ) 1418 1386 ENDIF … … 1444 1412 IF( lk_mpp ) THEN 1445 1413 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1446 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1414 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1447 1415 misfdep(:,:) = INT( zbathy(:,:) ) 1448 1416 1449 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1450 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1417 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1418 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1451 1419 1452 1420 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1453 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1421 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1454 1422 mbathy(:,:) = INT( zbathy(:,:) ) 1455 1423 ENDIF … … 1481 1449 IF( lk_mpp ) THEN 1482 1450 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1483 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1451 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1484 1452 misfdep(:,:) = INT( zbathy(:,:) ) 1485 1453 1486 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1487 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1454 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1455 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1488 1456 1489 1457 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1490 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1458 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1491 1459 mbathy(:,:) = INT( zbathy(:,:) ) 1492 1460 ENDIF … … 1518 1486 IF( lk_mpp ) THEN 1519 1487 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1520 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1488 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1521 1489 misfdep(:,:) = INT( zbathy(:,:) ) 1522 1490 1523 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1524 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1491 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1492 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1525 1493 1526 1494 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1527 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1495 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1528 1496 mbathy(:,:) = INT( zbathy(:,:) ) 1529 1497 ENDIF … … 1555 1523 IF( lk_mpp ) THEN 1556 1524 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1557 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1525 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1558 1526 misfdep(:,:) = INT( zbathy(:,:) ) 1559 1527 1560 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1561 CALL lbc_lnk(' toto', bathy, 'T', 1. )1528 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1529 CALL lbc_lnk('domzgr', bathy, 'T', 1. ) 1562 1530 1563 1531 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1564 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1532 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1565 1533 mbathy(:,:) = INT( zbathy(:,:) ) 1566 1534 ENDIF … … 1587 1555 IF( lk_mpp ) THEN 1588 1556 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1589 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1557 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1590 1558 misfdep(:,:) = INT( zbathy(:,:) ) 1591 1559 1592 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1593 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1560 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1561 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1594 1562 1595 1563 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1596 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1564 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1597 1565 mbathy(:,:) = INT( zbathy(:,:) ) 1598 1566 ENDIF … … 1623 1591 IF( lk_mpp ) THEN 1624 1592 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1625 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1593 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1626 1594 misfdep(:,:) = INT( zbathy(:,:) ) 1627 1595 1628 CALL lbc_lnk( ' toto',risfdep, 'T', 1. )1629 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1596 CALL lbc_lnk( 'domzgr',risfdep, 'T', 1. ) 1597 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1630 1598 1631 1599 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1632 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1600 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1633 1601 mbathy(:,:) = INT( zbathy(:,:) ) 1634 1602 ENDIF … … 1656 1624 IF( lk_mpp ) THEN 1657 1625 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1658 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1626 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1659 1627 misfdep(:,:) = INT( zbathy(:,:) ) 1660 1628 1661 CALL lbc_lnk( ' toto',risfdep, 'T', 1. )1662 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1629 CALL lbc_lnk( 'domzgr',risfdep, 'T', 1. ) 1630 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1663 1631 1664 1632 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1665 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1633 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1666 1634 mbathy(:,:) = INT( zbathy(:,:) ) 1667 1635 ENDIF … … 1676 1644 IF( lk_mpp ) THEN 1677 1645 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1678 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1646 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1679 1647 misfdep(:,:) = INT( zbathy(:,:) ) 1680 1648 1681 CALL lbc_lnk(' toto', risfdep, 'T', 1. )1682 CALL lbc_lnk(' toto', bathy, 'T', 1. )1649 CALL lbc_lnk('domzgr', risfdep, 'T', 1. ) 1650 CALL lbc_lnk('domzgr', bathy, 'T', 1. ) 1683 1651 1684 1652 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1685 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1653 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1686 1654 mbathy(:,:) = INT( zbathy(:,:) ) 1687 1655 ENDIF … … 1696 1664 IF( lk_mpp ) THEN 1697 1665 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1698 CALL lbc_lnk(' toto', zbathy, 'T', 1. )1666 CALL lbc_lnk('domzgr', zbathy, 'T', 1. ) 1699 1667 misfdep(:,:) = INT( zbathy(:,:) ) 1700 1668 1701 CALL lbc_lnk(' toto', risfdep,'T', 1. )1702 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1669 CALL lbc_lnk('domzgr', risfdep,'T', 1. ) 1670 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1703 1671 1704 1672 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1705 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1673 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1706 1674 mbathy(:,:) = INT( zbathy(:,:) ) 1707 1675 ENDIF … … 1716 1684 IF( lk_mpp ) THEN 1717 1685 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1718 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1686 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1719 1687 misfdep(:,:) = INT( zbathy(:,:) ) 1720 1688 1721 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1722 CALL lbc_lnk(' toto', bathy, 'T', 1. )1689 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1690 CALL lbc_lnk('domzgr', bathy, 'T', 1. ) 1723 1691 1724 1692 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1725 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1693 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1726 1694 mbathy(:,:) = INT( zbathy(:,:) ) 1727 1695 ENDIF … … 1736 1704 IF( lk_mpp ) THEN 1737 1705 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1738 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1706 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1739 1707 misfdep(:,:) = INT( zbathy(:,:) ) 1740 1708 1741 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1742 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1709 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1710 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1743 1711 1744 1712 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1745 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1713 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1746 1714 mbathy(:,:) = INT( zbathy(:,:) ) 1747 1715 ENDIF … … 1877 1845 END DO 1878 1846 1879 CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep ) 1880 CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy ) 1881 ! 1882 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_isf') 1883 ! 1847 DEALLOCATE( zbathy, zmask, zrisfdep ) 1848 DEALLOCATE( zmisfdep, zmbathy ) 1849 ! 1884 1850 END SUBROUTINE zgr_isf 1885 1851 … … 1935 1901 REAL(wp) :: zrfact 1936 1902 ! 1937 REAL(wp), POINTER, DIMENSION(:,: ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj21938 REAL(wp), POINTER, DIMENSION(:,: ) :: zenv, ztmp, zmsk, zri, zrj, zhbat1903 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 1904 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 1939 1905 !! 1940 1906 NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & … … 1942 1908 !!---------------------------------------------------------------------- 1943 1909 ! 1944 !! IF( nn_timing == 1 ) CALL timing_start('zgr_sco') 1945 ! 1946 CALL wrk_alloc( jpi,jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 1910 ALLOCATE( zenv(jpi,jpj), ztmp(jpi,jpj), zmsk(jpi,jpj), zri(jpi,jpj), zrj(jpi,jpj), zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj) ) 1947 1911 ! 1948 1912 REWIND( numnam_ref ) ! Namelist namzgr_sco in reference namelist : Sigma-stretching parameters … … 2024 1988 2025 1989 ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero 2026 CALL lbc_lnk( ' toto',zenv, 'T', 1._wp, 'no0' )1990 CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, 'no0' ) 2027 1991 ! 2028 1992 ! smooth the bathymetry (if required) … … 2088 2052 END DO 2089 2053 ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero 2090 CALL lbc_lnk( ' toto',zenv, 'T', 1._wp, 'no0' )2054 CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, 'no0' ) 2091 2055 ! ! ================ ! 2092 2056 END DO ! End loop ! … … 2132 2096 ! Apply lateral boundary condition 2133 2097 !!gm ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL 2134 zhbat(:,:) = hbatu(:,:) ; CALL lbc_lnk(' toto', hbatu, 'U', 1._wp )2098 zhbat(:,:) = hbatu(:,:) ; CALL lbc_lnk('domzgr', hbatu, 'U', 1._wp ) 2135 2099 DO jj = 1, jpj 2136 2100 DO ji = 1, jpi … … 2142 2106 END DO 2143 2107 END DO 2144 zhbat(:,:) = hbatv(:,:) ; CALL lbc_lnk(' toto', hbatv, 'V', 1._wp )2108 zhbat(:,:) = hbatv(:,:) ; CALL lbc_lnk('domzgr', hbatv, 'V', 1._wp ) 2145 2109 DO jj = 1, jpj 2146 2110 DO ji = 1, jpi … … 2151 2115 END DO 2152 2116 END DO 2153 zhbat(:,:) = hbatf(:,:) ; CALL lbc_lnk(' toto', hbatf, 'F', 1._wp )2117 zhbat(:,:) = hbatf(:,:) ; CALL lbc_lnk('domzgr', hbatf, 'F', 1._wp ) 2154 2118 DO jj = 1, jpj 2155 2119 DO ji = 1, jpi … … 2199 2163 ENDIF 2200 2164 2201 CALL lbc_lnk( ' toto',e3t_0 , 'T', 1._wp )2202 CALL lbc_lnk( ' toto',e3u_0 , 'U', 1._wp )2203 CALL lbc_lnk( ' toto',e3v_0 , 'V', 1._wp )2204 CALL lbc_lnk( ' toto',e3f_0 , 'F', 1._wp )2205 CALL lbc_lnk( ' toto',e3w_0 , 'W', 1._wp )2206 CALL lbc_lnk( ' toto',e3uw_0, 'U', 1._wp )2207 CALL lbc_lnk(' toto', e3vw_0, 'V', 1._wp )2165 CALL lbc_lnk( 'domzgr',e3t_0 , 'T', 1._wp ) 2166 CALL lbc_lnk( 'domzgr',e3u_0 , 'U', 1._wp ) 2167 CALL lbc_lnk( 'domzgr',e3v_0 , 'V', 1._wp ) 2168 CALL lbc_lnk( 'domzgr',e3f_0 , 'F', 1._wp ) 2169 CALL lbc_lnk( 'domzgr',e3w_0 , 'W', 1._wp ) 2170 CALL lbc_lnk( 'domzgr',e3uw_0, 'U', 1._wp ) 2171 CALL lbc_lnk('domzgr', e3vw_0, 'V', 1._wp ) 2208 2172 ! 2209 2173 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp … … 2214 2178 WHERE( e3uw_0(:,:,:) == 0._wp ) e3uw_0(:,:,:) = 1._wp 2215 2179 WHERE( e3vw_0(:,:,:) == 0._wp ) e3vw_0(:,:,:) = 1._wp 2216 2217 2218 !!gm I don't like that HERE we are supposed to set the reference coordinate (i.e. _0 arrays)2219 !!gm and only that !!!!!2220 !!gm THIS should be removed from here !2221 gdept_n(:,:,:) = gdept_0(:,:,:)2222 gdepw_n(:,:,:) = gdepw_0(:,:,:)2223 gde3w_n(:,:,:) = gde3w_0(:,:,:)2224 e3t_n (:,:,:) = e3t_0 (:,:,:)2225 e3u_n (:,:,:) = e3u_0 (:,:,:)2226 e3v_n (:,:,:) = e3v_0 (:,:,:)2227 e3f_n (:,:,:) = e3f_0 (:,:,:)2228 e3w_n (:,:,:) = e3w_0 (:,:,:)2229 e3uw_n (:,:,:) = e3uw_0 (:,:,:)2230 e3vw_n (:,:,:) = e3vw_0 (:,:,:)2231 !!gm and obviously in the following, use the _0 arrays until the end of this subroutine2232 !! gm end2233 2180 !! 2234 2181 ! HYBRID : … … 2236 2183 DO ji = 1, jpi 2237 2184 DO jk = 1, jpkm1 2238 IF( scobot(ji,jj) >= gdept_ n(ji,jj,jk) ) mbathy(ji,jj) = MAX( 2, jk )2185 IF( scobot(ji,jj) >= gdept_0(ji,jj,jk) ) mbathy(ji,jj) = MAX( 2, jk ) 2239 2186 END DO 2240 2187 END DO … … 2298 2245 DO jk = 1, mbathy(ji,jj) 2299 2246 ! check coordinate is monotonically increasing 2300 IF (e3w_ n(ji,jj,jk) <= 0._wp .OR. e3t_n(ji,jj,jk) <= 0._wp ) THEN2247 IF (e3w_0(ji,jj,jk) <= 0._wp .OR. e3t_0(ji,jj,jk) <= 0._wp ) THEN 2301 2248 WRITE(ctmp1,*) 'ERROR zgr_sco : e3w or e3t =< 0 at point (i,j,k)= ', ji, jj, jk 2302 2249 WRITE(numout,*) 'ERROR zgr_sco : e3w or e3t =< 0 at point (i,j,k)= ', ji, jj, jk 2303 WRITE(numout,*) 'e3w',e3w_ n(ji,jj,:)2304 WRITE(numout,*) 'e3t',e3t_ n(ji,jj,:)2250 WRITE(numout,*) 'e3w',e3w_0(ji,jj,:) 2251 WRITE(numout,*) 'e3t',e3t_0(ji,jj,:) 2305 2252 CALL ctl_stop( ctmp1 ) 2306 2253 ENDIF 2307 2254 ! and check it has never gone negative 2308 IF( gdepw_ n(ji,jj,jk) < 0._wp .OR. gdept_n(ji,jj,jk) < 0._wp ) THEN2255 IF( gdepw_0(ji,jj,jk) < 0._wp .OR. gdept_0(ji,jj,jk) < 0._wp ) THEN 2309 2256 WRITE(ctmp1,*) 'ERROR zgr_sco : gdepw or gdept =< 0 at point (i,j,k)= ', ji, jj, jk 2310 2257 WRITE(numout,*) 'ERROR zgr_sco : gdepw or gdept =< 0 at point (i,j,k)= ', ji, jj, jk 2311 WRITE(numout,*) 'gdepw',gdepw_ n(ji,jj,:)2312 WRITE(numout,*) 'gdept',gdept_ n(ji,jj,:)2258 WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:) 2259 WRITE(numout,*) 'gdept',gdept_0(ji,jj,:) 2313 2260 CALL ctl_stop( ctmp1 ) 2314 2261 ENDIF 2315 2262 ! and check it never exceeds the total depth 2316 IF( gdepw_ n(ji,jj,jk) > hbatt(ji,jj) ) THEN2263 IF( gdepw_0(ji,jj,jk) > hbatt(ji,jj) ) THEN 2317 2264 WRITE(ctmp1,*) 'ERROR zgr_sco : gdepw > hbatt at point (i,j,k)= ', ji, jj, jk 2318 2265 WRITE(numout,*) 'ERROR zgr_sco : gdepw > hbatt at point (i,j,k)= ', ji, jj, jk 2319 WRITE(numout,*) 'gdepw',gdepw_ n(ji,jj,:)2266 WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:) 2320 2267 CALL ctl_stop( ctmp1 ) 2321 2268 ENDIF … … 2324 2271 DO jk = 1, mbathy(ji,jj)-1 2325 2272 ! and check it never exceeds the total depth 2326 IF( gdept_ n(ji,jj,jk) > hbatt(ji,jj) ) THEN2273 IF( gdept_0(ji,jj,jk) > hbatt(ji,jj) ) THEN 2327 2274 WRITE(ctmp1,*) 'ERROR zgr_sco : gdept > hbatt at point (i,j,k)= ', ji, jj, jk 2328 2275 WRITE(numout,*) 'ERROR zgr_sco : gdept > hbatt at point (i,j,k)= ', ji, jj, jk 2329 WRITE(numout,*) 'gdept',gdept_ n(ji,jj,:)2276 WRITE(numout,*) 'gdept',gdept_0(ji,jj,:) 2330 2277 CALL ctl_stop( ctmp1 ) 2331 2278 ENDIF … … 2335 2282 END DO 2336 2283 ! 2337 CALL wrk_dealloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 2338 ! 2339 !!! IF( nn_timing == 1 ) CALL timing_stop('zgr_sco') 2284 DEALLOCATE( zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 2340 2285 ! 2341 2286 END SUBROUTINE zgr_sco … … 2358 2303 REAL(wp) :: ztmpu1, ztmpv1, ztmpf1 2359 2304 ! 2360 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 2361 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 2362 !!---------------------------------------------------------------------- 2363 2364 CALL wrk_alloc( jpi,jpj,jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) 2365 CALL wrk_alloc( jpi,jpj,jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2305 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 2306 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 2307 !!---------------------------------------------------------------------- 2308 2309 ALLOCATE( z_gsigw3 (jpi,jpj,jpk), z_gsigt3 (jpi,jpj,jpk), z_gsi3w3 (jpi,jpj,jpk) ) 2310 ALLOCATE( z_esigt3 (jpi,jpj,jpk), z_esigw3 (jpi,jpj,jpk), z_esigtu3(jpi,jpj,jpk), z_esigtv3(jpi,jpj,jpk) ) 2311 ALLOCATE( z_esigtf3(jpi,jpj,jpk), z_esigwu3(jpi,jpj,jpk), z_esigwv3(jpi,jpj,jpk) ) 2366 2312 2367 2313 z_gsigw3 = 0._wp ; z_gsigt3 = 0._wp ; z_gsi3w3 = 0._wp … … 2448 2394 END DO 2449 2395 ! 2450 CALL wrk_dealloc( jpi,jpj,jpk,z_gsigw3, z_gsigt3, z_gsi3w3 )2451 CALL wrk_dealloc( jpi,jpj,jpk,z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )2396 DEALLOCATE( z_gsigw3, z_gsigt3, z_gsi3w3 ) 2397 DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2452 2398 ! 2453 2399 END SUBROUTINE s_sh94 … … 2476 2422 REAL(wp) :: ztmpu1, ztmpv1, ztmpf1 2477 2423 ! 2478 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 2479 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 2480 !!---------------------------------------------------------------------- 2481 ! 2482 CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) 2483 CALL wrk_alloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2424 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 2425 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 2426 !!---------------------------------------------------------------------- 2427 ! 2428 ALLOCATE( z_gsigw3 (jpi,jpj,jpk), z_gsigt3 (jpi,jpj,jpk), z_gsi3w3 (jpi,jpj,jpk) ) 2429 ALLOCATE( z_esigt3 (jpi,jpj,jpk), z_esigw3 (jpi,jpj,jpk), z_esigtu3(jpi,jpj,jpk), z_esigtv3(jpi,jpj,jpk)) 2430 ALLOCATE( z_esigtf3(jpi,jpj,jpk), z_esigwu3(jpi,jpj,jpk), z_esigwv3(jpi,jpj,jpk) ) 2484 2431 2485 2432 z_gsigw3 = 0._wp ; z_gsigt3 = 0._wp ; z_gsi3w3 = 0._wp … … 2608 2555 ENDDO 2609 2556 ! 2610 CALL lbc_lnk(' toto',e3t_0 ,'T',1.) ; CALL lbc_lnk('toto',e3u_0 ,'T',1.)2611 CALL lbc_lnk(' toto',e3v_0 ,'T',1.) ; CALL lbc_lnk('toto',e3f_0 ,'T',1.)2612 CALL lbc_lnk(' toto',e3w_0 ,'T',1.)2613 CALL lbc_lnk(' toto',e3uw_0,'T',1.) ; CALL lbc_lnk('toto',e3vw_0,'T',1.)2614 ! 2615 CALL wrk_dealloc( jpi,jpj,jpk,z_gsigw3, z_gsigt3, z_gsi3w3 )2616 CALL wrk_dealloc( jpi,jpj,jpk,z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )2557 CALL lbc_lnk('domzgr',e3t_0 ,'T',1.) ; CALL lbc_lnk('domzgr',e3u_0 ,'T',1.) 2558 CALL lbc_lnk('domzgr',e3v_0 ,'T',1.) ; CALL lbc_lnk('domzgr',e3f_0 ,'T',1.) 2559 CALL lbc_lnk('domzgr',e3w_0 ,'T',1.) 2560 CALL lbc_lnk('domzgr',e3uw_0,'T',1.) ; CALL lbc_lnk('domzgr',e3vw_0,'T',1.) 2561 ! 2562 DEALLOCATE( z_gsigw3, z_gsigt3, z_gsi3w3 ) 2563 DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2617 2564 ! 2618 2565 END SUBROUTINE s_sf12 … … 2631 2578 INTEGER :: ji, jj, jk ! dummy loop argument 2632 2579 REAL(wp) :: zcoeft, zcoefw ! temporary scalars 2633 REAL(wp), POINTER, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w2634 REAL(wp), POINTER, DIMENSION(:) :: z_esigt, z_esigw2635 !!---------------------------------------------------------------------- 2636 2637 CALL wrk_alloc( jpk, z_gsigw, z_gsigt, z_gsi3w)2638 CALL wrk_alloc( jpk, z_esigt, z_esigw)2580 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w 2581 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_esigt, z_esigw 2582 !!---------------------------------------------------------------------- 2583 2584 ALLOCATE( z_gsigw(jpk), z_gsigt(jpk), z_gsi3w(jpk) ) 2585 ALLOCATE( z_esigt(jpk), z_esigw(jpk) ) 2639 2586 2640 2587 z_gsigw = 0._wp ; z_gsigt = 0._wp ; z_gsi3w = 0._wp … … 2686 2633 END DO 2687 2634 ! 2688 CALL wrk_dealloc( jpk,z_gsigw, z_gsigt, z_gsi3w )2689 CALL wrk_dealloc( jpk,z_esigt, z_esigw )2635 DEALLOCATE( z_gsigw, z_gsigt, z_gsi3w ) 2636 DEALLOCATE( z_esigt, z_esigw ) 2690 2637 ! 2691 2638 END SUBROUTINE s_tanh -
NEMO/branches/2019/ENHANCE-03_domcfg/src/iom.F90
r10727 r11129 64 64 PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active 65 65 # endif 66 PUBLIC iom_set_rstw_var_active, iom_set_rst w_core, iom_set_rst_vars66 PUBLIC iom_set_rstw_var_active, iom_set_rst_vars 67 67 68 68 INTERFACE iom_get … … 348 348 #endif 349 349 END SUBROUTINE iom_set_rstr_active 350 351 SUBROUTINE iom_set_rstw_core(cdmdl)352 !!---------------------------------------------------------------------353 !! *** SUBROUTINE iom_set_rstw_core ***354 !!355 !! ** Purpose : set variables which are always in restart file356 !!---------------------------------------------------------------------357 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS358 CHARACTER(LEN=256) :: clinfo ! info character359 #if defined key_iomput360 IF(cdmdl == "OPA") THEN361 !from restart.F90362 CALL iom_set_rstw_var_active("rdt")363 IF ( .NOT. ln_diurnal_only ) THEN364 CALL iom_set_rstw_var_active('ub' )365 CALL iom_set_rstw_var_active('vb' )366 CALL iom_set_rstw_var_active('tb' )367 CALL iom_set_rstw_var_active('sb' )368 CALL iom_set_rstw_var_active('sshb')369 !370 CALL iom_set_rstw_var_active('un' )371 CALL iom_set_rstw_var_active('vn' )372 CALL iom_set_rstw_var_active('tn' )373 CALL iom_set_rstw_var_active('sn' )374 CALL iom_set_rstw_var_active('sshn')375 CALL iom_set_rstw_var_active('rhop')376 ! extra variable needed for the ice sheet coupling377 IF ( ln_iscpl ) THEN378 CALL iom_set_rstw_var_active('tmask')379 CALL iom_set_rstw_var_active('umask')380 CALL iom_set_rstw_var_active('vmask')381 CALL iom_set_rstw_var_active('smask')382 CALL iom_set_rstw_var_active('e3t_n')383 CALL iom_set_rstw_var_active('e3u_n')384 CALL iom_set_rstw_var_active('e3v_n')385 CALL iom_set_rstw_var_active('gdepw_n')386 END IF387 ENDIF388 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst')389 !from trasbc.F90390 CALL iom_set_rstw_var_active('sbc_hc_b')391 CALL iom_set_rstw_var_active('sbc_sc_b')392 ENDIF393 #else394 clinfo = 'iom_set_rstw_core: key_iomput is needed to use XIOS restart read/write functionality'395 CALL ctl_stop('STOP', TRIM(clinfo))396 #endif397 END SUBROUTINE iom_set_rstw_core398 350 399 351 SUBROUTINE iom_set_rst_vars(fields) -
NEMO/branches/2019/ENHANCE-03_domcfg/src/lbclnk.F90
r10727 r11129 71 71 !! lbc_bdy_lnk : set the lateral BDY boundary condition 72 72 !!---------------------------------------------------------------------- 73 USE oce ! ocean dynamics and tracers74 73 USE dom_oce ! ocean space and time domain 75 74 USE in_out_manager ! I/O manager -
NEMO/branches/2019/ENHANCE-03_domcfg/src/nemogcm.F90
r10727 r11129 44 44 !! factorise : calculate the factors of the no. of MPI processes 45 45 !!---------------------------------------------------------------------- 46 USE step_oce ! module used in the ocean time stepping module (step.F90) 46 USE dom_oce ! ocean space and time domain variables 47 USE in_out_manager ! I/O manager 48 USE iom ! 47 49 USE domcfg ! domain configuration (dom_cfg routine) 48 50 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 97 99 CALL nemo_init !== Initialisations ==! 98 100 ! !-----------------------! 101 PRINT *, 'end nemo init' 99 102 100 103 #if defined key_agrif … … 126 129 ! 127 130 ! 131 PRINT *, 'close file' 128 132 CALL nemo_closefile 133 PRINT *, 'The end' 129 134 ! 130 135 ! … … 141 146 INTEGER :: ios, ilocal_comm ! local integers 142 147 CHARACTER(len=120), DIMENSION(60) :: cltxt, cltxt2, clnam 143 ! 144 NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print,ln_timing 148 !! 149 NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print, nn_ictls, nn_ictle, & 150 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 151 & ln_timing, ln_diacfl 145 152 NAMELIST/namcfg/ ln_e3_dep, & 146 153 & cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & … … 154 161 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 155 162 ! 156 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark163 REWIND( numnam_ref ) ! Namelist namctl in reference namelist 157 164 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 158 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 159 160 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist : Control prints & Benchmark 165 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 166 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist 161 167 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 162 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 163 164 ! 165 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints & Benchmark 168 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 169 ! 170 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 166 171 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 167 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 168 169 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark 172 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 173 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 170 174 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 171 904 IF( ios /= 0 )CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )175 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 172 176 173 177 ! Force values for AGRIF zoom (cf. agrif_user.F90) … … 265 269 CALL dom_cfg ! Domain configuration 266 270 CALL dom_init ! Domain 267 IF( ln_ctl ) CALL prt_ctl_init ! Print control268 271 ! 269 272 END SUBROUTINE nemo_init … … 409 412 !!---------------------------------------------------------------------- 410 413 ! 411 ierr = oce_alloc () ! ocean 412 ierr = ierr + dom_oce_alloc () ! ocean domain 414 ierr = dom_oce_alloc () ! ocean domain 413 415 ! 414 416 CALL mpp_sum( 'nemogcm', ierr )
Note: See TracChangeset
for help on using the changeset viewer.
