Changeset 13286 for NEMO/trunk/src/OCE/DOM
- Timestamp:
- 2020-07-09T17:48:29+02:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 1 deleted
- 12 edited
- 1 copied
-
. (modified) (1 prop)
-
src/OCE/DOM/closea.F90 (modified) (2 diffs)
-
src/OCE/DOM/daymod.F90 (modified) (1 diff)
-
src/OCE/DOM/dom_oce.F90 (modified) (5 diffs)
-
src/OCE/DOM/domain.F90 (modified) (10 diffs)
-
src/OCE/DOM/domhgr.F90 (modified) (7 diffs)
-
src/OCE/DOM/dommsk.F90 (modified) (7 diffs)
-
src/OCE/DOM/domngb.F90 (deleted)
-
src/OCE/DOM/domqco.F90 (modified) (3 diffs)
-
src/OCE/DOM/domutl.F90 (copied) (copied from NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domutl.F90)
-
src/OCE/DOM/domvvl.F90 (modified) (7 diffs)
-
src/OCE/DOM/domwri.F90 (modified) (3 diffs)
-
src/OCE/DOM/domzgr.F90 (modified) (6 diffs)
-
src/OCE/DOM/dtatsd.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 2 2 ^/utils/build/makenemo@HEAD makenemo 3 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools /@HEADtools4 ^/utils/tools@HEAD tools 5 5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM … … 8 8 9 9 # SETTE 10 ^/utils/CI/ sette@12931sette10 ^/utils/CI/r12931_sette_ticket2366@HEAD sette
-
- Property svn:externals
-
NEMO/trunk/src/OCE/DOM/closea.F90
r12377 r13286 22 22 ! 23 23 USE diu_bulk , ONLY: ln_diurnal_only ! used for sanity check 24 USE iom , ONLY: iom_open, iom_get, iom_close, jpdom_ data! I/O routines24 USE iom , ONLY: iom_open, iom_get, iom_close, jpdom_global ! I/O routines 25 25 USE lib_fortran , ONLY: glob_sum ! fortran library 26 26 USE lib_mpp , ONLY: mpp_max, ctl_nam, ctl_stop ! MPP library … … 236 236 ! 237 237 CALL iom_open ( cd_file, ics ) 238 CALL iom_get ( ics, jpdom_ data, TRIM(cd_var), zdta )238 CALL iom_get ( ics, jpdom_global, TRIM(cd_var), zdta ) 239 239 CALL iom_close( ics ) 240 240 k_mskout(:,:) = NINT(zdta(:,:)) -
NEMO/trunk/src/OCE/DOM/daymod.F90
r13226 r13286 279 279 IF(sn_cfctl%l_prtctl) THEN 280 280 WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 281 CALL prt_ctl_info( charout)281 CALL prt_ctl_info( charout ) 282 282 ENDIF 283 283 -
NEMO/trunk/src/OCE/DOM/dom_oce.F90
r13237 r13286 76 76 ! !: domain MPP decomposition parameters 77 77 INTEGER , PUBLIC :: nimpp, njmpp !: i- & j-indexes for mpp-subdomain left bottom 78 INTEGER , PUBLIC :: nreci, nrecj !: overlap region in i and j79 78 INTEGER , PUBLIC :: nproc !: number for local processor 80 79 INTEGER , PUBLIC :: narea !: number for local area … … 86 85 87 86 INTEGER, PUBLIC :: npolj !: north fold mark (0, 3 or 4) 88 INTEGER, PUBLIC :: nlci, nldi, nlei !: i-dimensions of the local subdomain and its first and last indoor indices89 INTEGER, PUBLIC :: nlcj, nldj, nlej !: i-dimensions of the local subdomain and its first and last indoor indices90 87 INTEGER, PUBLIC :: noea, nowe !: index of the local neighboring processors in 91 88 INTEGER, PUBLIC :: noso, nono !: east, west, south and north directions 92 89 INTEGER, PUBLIC :: nidom !: ??? 93 90 94 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig !: local ==> global domain i-index 95 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg !: local ==> global domain j-index 96 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mi0, mi1 !: global ==> local domain i-index (mi0=1 and mi1=0 if the global index 97 ! ! is not in the local domain) 98 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mj0, mj1 !: global ==> local domain j-index (mj0=1 and mj1=0 if the global index 99 ! ! is not in the local domain) 100 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nimppt, njmppt !: i-, j-indexes for each processor 101 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ibonit, ibonjt !: i-, j- processor neighbour existence 102 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nlcit , nlcjt !: dimensions of every subdomain 103 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nldit , nldjt !: first, last indoor index for each i-domain 104 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nleit , nlejt !: first, last indoor index for each j-domain 105 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit 91 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig !: local ==> global domain, including halos (jpiglo), i-index 92 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg !: local ==> global domain, including halos (jpjglo), j-index 93 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig0 !: local ==> global domain, excluding halos (Ni0glo), i-index 94 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg0 !: local ==> global domain, excluding halos (Nj0glo), j-index 95 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig0_oldcmp !: local ==> global domain, excluding halos (Ni0glo), i-index 96 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg0_oldcmp !: local ==> global domain, excluding halos (Nj0glo), j-index 97 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mi0, mi1 !: global, including halos (jpiglo) ==> local domain i-index 98 ! !: (mi0=1 and mi1=0 if global index not in local domain) 99 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mj0, mj1 !: global, including halos (jpjglo) ==> local domain j-index 100 ! !: (mj0=1 and mj1=0 if global index not in local domain) 101 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nimppt, njmppt !: i-, j-indexes for each processor 102 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ibonit, ibonjt !: i-, j- processor neighbour existence 103 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: jpiall, jpjall !: dimensions of all subdomain 104 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nis0all, njs0all !: first, last indoor index for all i-subdomain 105 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nie0all, nje0all !: first, last indoor index for all j-subdomain 106 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nfimpp, nfproc, nfjpi 106 107 107 108 !!---------------------------------------------------------------------- … … 116 117 ! 117 118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point 118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u!: associated metrics at u-point119 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v!: associated metrics at v-point119 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2u , e2_e1u, r1_e1e2u !: associated metrics at u-point 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2v , e1_e2v, r1_e1e2v !: associated metrics at v-point 120 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point 121 122 ! … … 187 188 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_h !: internal domain T-point mask (Figure 8.5 NEMO book) 188 189 189 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF)190 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF) 190 191 191 192 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts 192 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts 193 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask !: land/ocean mask at WT-, WU- and WV-pts 194 195 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tpol, fpol !: north fold mask (jperio= 3 or 4) 193 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts 194 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WT-, WU- and WV-pts 196 195 197 196 !!---------------------------------------------------------------------- … … 262 261 ! 263 262 ii = ii+1 264 ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(ii) ) 265 ! 266 ii = ii+1 267 ALLOCATE( mi0(jpiglo) , mi1 (jpiglo), mj0(jpjglo) , mj1 (jpjglo) , & 268 & tpol(jpiglo) , fpol(jpiglo) , STAT=ierr(ii) ) 263 ALLOCATE( mig(jpi), mjg(jpj), mig0(jpi), mjg0(jpj), mig0_oldcmp(jpi), mjg0_oldcmp(jpj), STAT=ierr(ii) ) 264 ! 265 ii = ii+1 266 ALLOCATE( mi0(jpiglo), mi1(jpiglo), mj0(jpjglo), mj1(jpjglo), STAT=ierr(ii) ) 269 267 ! 270 268 ii = ii+1 -
NEMO/trunk/src/OCE/DOM/domain.F90
r13237 r13286 240 240 !! ** Method : 241 241 !! 242 !! ** Action : - mig , mjg : local domain indices ==> global domain indices 242 !! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices 243 !! - mig0, mjg0: local domain indices ==> global domain, excluding halos, indices 243 244 !! - mi0 , mi1 : global domain indices ==> local domain indices 244 !! - mj0 ,, mj1 (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)245 !! - mj0 , mj1 (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 245 246 !!---------------------------------------------------------------------- 246 247 INTEGER :: ji, jj ! dummy loop argument 247 248 !!---------------------------------------------------------------------- 248 249 ! 249 DO ji = 1, jpi ! local domain indices ==> global domain indices250 DO ji = 1, jpi ! local domain indices ==> global domain, including halos, indices 250 251 mig(ji) = ji + nimpp - 1 251 252 END DO … … 253 254 mjg(jj) = jj + njmpp - 1 254 255 END DO 255 ! ! global domain indices ==> local domain indices 256 ! ! local domain indices ==> global domain, excluding halos, indices 257 ! 258 mig0(:) = mig(:) - nn_hls 259 mjg0(:) = mjg(:) - nn_hls 260 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 261 ! we must define mig0 and mjg0 as bellow. 262 ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 263 mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 264 mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 265 ! 266 ! ! global domain, including halos, indices ==> local domain indices 256 267 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 257 268 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. … … 271 282 WRITE(numout,*) ' local domain: jpi = ', jpi , ' jpj = ', jpj , ' jpk = ', jpk 272 283 WRITE(numout,*) 273 WRITE(numout,*) ' conversion from local to global domain indices (and vise versa) done' 274 IF( nn_print >= 1 ) THEN 275 WRITE(numout,*) 276 WRITE(numout,*) ' conversion local ==> global i-index domain (mig)' 277 WRITE(numout,25) (mig(ji),ji = 1,jpi) 278 WRITE(numout,*) 279 WRITE(numout,*) ' conversion global ==> local i-index domain' 280 WRITE(numout,*) ' starting index (mi0)' 281 WRITE(numout,25) (mi0(ji),ji = 1,jpiglo) 282 WRITE(numout,*) ' ending index (mi1)' 283 WRITE(numout,25) (mi1(ji),ji = 1,jpiglo) 284 WRITE(numout,*) 285 WRITE(numout,*) ' conversion local ==> global j-index domain (mjg)' 286 WRITE(numout,25) (mjg(jj),jj = 1,jpj) 287 WRITE(numout,*) 288 WRITE(numout,*) ' conversion global ==> local j-index domain' 289 WRITE(numout,*) ' starting index (mj0)' 290 WRITE(numout,25) (mj0(jj),jj = 1,jpjglo) 291 WRITE(numout,*) ' ending index (mj1)' 292 WRITE(numout,25) (mj1(jj),jj = 1,jpjglo) 293 ENDIF 294 ENDIF 295 25 FORMAT( 100(10x,19i4,/) ) 284 ENDIF 296 285 ! 297 286 END SUBROUTINE dom_glo … … 413 402 #endif 414 403 415 #if defined key_agrif416 404 IF( Agrif_Root() ) THEN 417 #endif 418 IF(lwp) WRITE(numout,*) 419 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 420 CASE ( 1 ) 421 CALL ioconf_calendar('gregorian') 422 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year' 423 CASE ( 0 ) 424 CALL ioconf_calendar('noleap') 425 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year' 426 CASE ( 30 ) 427 CALL ioconf_calendar('360d') 428 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year' 429 END SELECT 430 #if defined key_agrif 431 ENDIF 432 #endif 405 IF(lwp) WRITE(numout,*) 406 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 407 CASE ( 1 ) 408 CALL ioconf_calendar('gregorian') 409 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year' 410 CASE ( 0 ) 411 CALL ioconf_calendar('noleap') 412 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year' 413 CASE ( 30 ) 414 CALL ioconf_calendar('360d') 415 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year' 416 END SELECT 417 ENDIF 433 418 434 419 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) … … 503 488 !! ** Method : compute and print extrema of masked scale factors 504 489 !!---------------------------------------------------------------------- 505 INTEGER, DIMENSION(2) :: imi1, imi2, ima1, ima2506 INTEGER, DIMENSION(2) :: iloc !507 REAL(wp) ::ze1min, ze1max, ze2min, ze2max490 LOGICAL, DIMENSION(jpi,jpj) :: llmsk 491 INTEGER, DIMENSION(2) :: imil, imip, imi1, imi2, imal, imap, ima1, ima2 492 REAL(wp) :: zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max 508 493 !!---------------------------------------------------------------------- 509 494 ! 510 495 IF(lk_mpp) THEN 511 CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 512 CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 513 CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 514 CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 496 CALL mpp_minloc( 'domain', glamt(:,:), tmask_i(:,:), zglmin, imil ) 497 CALL mpp_minloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmin, imip ) 498 CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 499 CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 500 CALL mpp_maxloc( 'domain', glamt(:,:), tmask_i(:,:), zglmax, imal ) 501 CALL mpp_maxloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmax, imap ) 502 CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 503 CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 515 504 ELSE 516 ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 517 ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 518 ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 519 ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 520 ! 521 iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 522 imi1(1) = iloc(1) + nimpp - 1 523 imi1(2) = iloc(2) + njmpp - 1 524 iloc = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 525 imi2(1) = iloc(1) + nimpp - 1 526 imi2(2) = iloc(2) + njmpp - 1 527 iloc = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 528 ima1(1) = iloc(1) + nimpp - 1 529 ima1(2) = iloc(2) + njmpp - 1 530 iloc = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 531 ima2(1) = iloc(1) + nimpp - 1 532 ima2(2) = iloc(2) + njmpp - 1 533 ENDIF 505 llmsk = tmask_i(:,:) == 1._wp 506 zglmin = MINVAL( glamt(:,:), mask = llmsk ) 507 zgpmin = MINVAL( gphit(:,:), mask = llmsk ) 508 ze1min = MINVAL( e1t(:,:), mask = llmsk ) 509 ze2min = MINVAL( e2t(:,:), mask = llmsk ) 510 zglmin = MAXVAL( glamt(:,:), mask = llmsk ) 511 zgpmin = MAXVAL( gphit(:,:), mask = llmsk ) 512 ze1max = MAXVAL( e1t(:,:), mask = llmsk ) 513 ze2max = MAXVAL( e2t(:,:), mask = llmsk ) 514 ! 515 imil = MINLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 516 imip = MINLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 517 imi1 = MINLOC( e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 518 imi2 = MINLOC( e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 519 imal = MAXLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 520 imap = MAXLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 521 ima1 = MAXLOC( e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 522 ima2 = MAXLOC( e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 523 ENDIF 524 ! 534 525 IF(lwp) THEN 535 526 WRITE(numout,*) 536 527 WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 537 528 WRITE(numout,*) '~~~~~~~' 538 WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 539 WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 540 WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 541 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 529 WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2) 530 WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2) 531 WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2) 532 WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2) 533 WRITE(numout,"(14x,' e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 534 WRITE(numout,"(14x,' e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 535 WRITE(numout,"(14x,' e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 536 WRITE(numout,"(14x,' e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 542 537 ENDIF 543 538 ! … … 606 601 IF(lwp) THEN 607 602 WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg 608 WRITE(numout,*) ' jpiglo = ', kpi609 WRITE(numout,*) ' jpjglo = ', kpj603 WRITE(numout,*) ' Ni0glo = ', kpi 604 WRITE(numout,*) ' Nj0glo = ', kpj 610 605 WRITE(numout,*) ' jpkglo = ', kpk 611 606 WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio … … 631 626 !!---------------------------------------------------------------------- 632 627 INTEGER :: ji, jj, jk ! dummy loop indices 633 INTEGER :: izco, izps, isco, icav634 628 INTEGER :: inum ! local units 635 629 CHARACTER(len=21) :: clnam ! filename (mesh and mask informations) … … 646 640 ! 647 641 clnam = cn_domcfg_out ! filename (configuration information) 648 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 649 642 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 650 643 ! 651 644 ! !== ORCA family specificities ==! … … 655 648 ENDIF 656 649 ! 657 ! !== global domain size ==!658 !659 CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )660 CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )661 CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk , wp), ktype = jp_i4 )662 !663 650 ! !== domain characteristics ==! 664 651 ! … … 667 654 ! 668 655 ! ! type of vertical coordinate 669 IF( ln_zco ) THEN ; izco = 1 ; ELSE ; izco = 0 ; ENDIF 670 IF( ln_zps ) THEN ; izps = 1 ; ELSE ; izps = 0 ; ENDIF 671 IF( ln_sco ) THEN ; isco = 1 ; ELSE ; isco = 0 ; ENDIF 672 CALL iom_rstput( 0, 0, inum, 'ln_zco' , REAL( izco, wp), ktype = jp_i4 ) 673 CALL iom_rstput( 0, 0, inum, 'ln_zps' , REAL( izps, wp), ktype = jp_i4 ) 674 CALL iom_rstput( 0, 0, inum, 'ln_sco' , REAL( isco, wp), ktype = jp_i4 ) 656 CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 ) 657 CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 ) 658 CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 ) 675 659 ! 676 660 ! ! ocean cavities under iceshelves 677 IF( ln_isfcav ) THEN ; icav = 1 ; ELSE ; icav = 0 ; ENDIF 678 CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 661 CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 ) 679 662 ! 680 663 ! !== horizontal mesh ! -
NEMO/trunk/src/OCE/DOM/domhgr.F90
r10068 r13286 31 31 USE iom ! I/O library 32 32 USE lib_mpp ! MPP library 33 USE lbclnk ! lateal boundary condition / mpp exchanges 33 34 USE timing ! Timing 34 35 … … 88 89 ENDIF 89 90 ! 90 !91 91 IF( ln_read_cfg ) THEN !== read in mesh_mask.nc file ==! 92 ! 92 93 IF(lwp) WRITE(numout,*) 93 94 IF(lwp) WRITE(numout,*) ' ==>>> read horizontal mesh in ', TRIM( cn_domcfg ), ' file' … … 112 113 ! 113 114 ENDIF 114 !115 115 ! !== Coriolis parameter ==! (if necessary) 116 116 ! … … 126 126 ENDIF 127 127 ENDIF 128 129 128 ! 130 129 ! !== associated horizontal metrics ==! … … 150 149 e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 151 150 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 152 !153 151 ! 154 152 IF( ln_timing ) CALL timing_stop('dom_hgr') … … 189 187 CALL iom_open( cn_domcfg, inum ) 190 188 ! 191 CALL iom_get( inum, jpdom_ data, 'glamt', plamt, lrowattr=ln_use_jattr)192 CALL iom_get( inum, jpdom_ data, 'glamu', plamu, lrowattr=ln_use_jattr)193 CALL iom_get( inum, jpdom_ data, 'glamv', plamv, lrowattr=ln_use_jattr)194 CALL iom_get( inum, jpdom_ data, 'glamf', plamf, lrowattr=ln_use_jattr)195 ! 196 CALL iom_get( inum, jpdom_ data, 'gphit', pphit, lrowattr=ln_use_jattr)197 CALL iom_get( inum, jpdom_ data, 'gphiu', pphiu, lrowattr=ln_use_jattr)198 CALL iom_get( inum, jpdom_ data, 'gphiv', pphiv, lrowattr=ln_use_jattr)199 CALL iom_get( inum, jpdom_ data, 'gphif', pphif, lrowattr=ln_use_jattr)200 ! 201 CALL iom_get( inum, jpdom_ data, 'e1t' , pe1t , lrowattr=ln_use_jattr)202 CALL iom_get( inum, jpdom_ data, 'e1u' , pe1u , lrowattr=ln_use_jattr)203 CALL iom_get( inum, jpdom_ data, 'e1v' , pe1v , lrowattr=ln_use_jattr)204 CALL iom_get( inum, jpdom_ data, 'e1f' , pe1f , lrowattr=ln_use_jattr)205 ! 206 CALL iom_get( inum, jpdom_ data, 'e2t' , pe2t , lrowattr=ln_use_jattr)207 CALL iom_get( inum, jpdom_ data, 'e2u' , pe2u , lrowattr=ln_use_jattr)208 CALL iom_get( inum, jpdom_ data, 'e2v' , pe2v , lrowattr=ln_use_jattr)209 CALL iom_get( inum, jpdom_ data, 'e2f' , pe2f , lrowattr=ln_use_jattr)189 CALL iom_get( inum, jpdom_global, 'glamt', plamt, cd_type = 'T', psgn = 1._wp ) 190 CALL iom_get( inum, jpdom_global, 'glamu', plamu, cd_type = 'U', psgn = 1._wp ) 191 CALL iom_get( inum, jpdom_global, 'glamv', plamv, cd_type = 'V', psgn = 1._wp ) 192 CALL iom_get( inum, jpdom_global, 'glamf', plamf, cd_type = 'F', psgn = 1._wp ) 193 ! 194 CALL iom_get( inum, jpdom_global, 'gphit', pphit, cd_type = 'T', psgn = 1._wp ) 195 CALL iom_get( inum, jpdom_global, 'gphiu', pphiu, cd_type = 'U', psgn = 1._wp ) 196 CALL iom_get( inum, jpdom_global, 'gphiv', pphiv, cd_type = 'V', psgn = 1._wp ) 197 CALL iom_get( inum, jpdom_global, 'gphif', pphif, cd_type = 'F', psgn = 1._wp ) 198 ! 199 CALL iom_get( inum, jpdom_global, 'e1t' , pe1t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy ) 200 CALL iom_get( inum, jpdom_global, 'e1u' , pe1u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 201 CALL iom_get( inum, jpdom_global, 'e1v' , pe1v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 202 CALL iom_get( inum, jpdom_global, 'e1f' , pe1f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy ) 203 ! 204 CALL iom_get( inum, jpdom_global, 'e2t' , pe2t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy ) 205 CALL iom_get( inum, jpdom_global, 'e2u' , pe2u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 206 CALL iom_get( inum, jpdom_global, 'e2v' , pe2v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 207 CALL iom_get( inum, jpdom_global, 'e2f' , pe2f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy ) 210 208 ! 211 209 IF( iom_varid( inum, 'ff_f', ldstop = .FALSE. ) > 0 .AND. & 212 210 & iom_varid( inum, 'ff_t', ldstop = .FALSE. ) > 0 ) THEN 213 211 IF(lwp) WRITE(numout,*) ' Coriolis factor at f- and t-points read in ', TRIM( cn_domcfg ), ' file' 214 CALL iom_get( inum, jpdom_ data, 'ff_f' , pff_f , lrowattr=ln_use_jattr)215 CALL iom_get( inum, jpdom_ data, 'ff_t' , pff_t , lrowattr=ln_use_jattr)212 CALL iom_get( inum, jpdom_global, 'ff_f', pff_f, cd_type = 'F', psgn = 1._wp ) 213 CALL iom_get( inum, jpdom_global, 'ff_t', pff_t, cd_type = 'T', psgn = 1._wp ) 216 214 kff = 1 217 215 ELSE … … 221 219 IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN 222 220 IF(lwp) WRITE(numout,*) ' e1e2u & e1e2v read in ', TRIM( cn_domcfg ), ' file' 223 CALL iom_get( inum, jpdom_ data, 'e1e2u' , pe1e2u , lrowattr=ln_use_jattr)224 CALL iom_get( inum, jpdom_ data, 'e1e2v' , pe1e2v , lrowattr=ln_use_jattr)221 CALL iom_get( inum, jpdom_global, 'e1e2u', pe1e2u, cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 222 CALL iom_get( inum, jpdom_global, 'e1e2v', pe1e2v, cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 225 223 ke1e2u_v = 1 226 224 ELSE -
NEMO/trunk/src/OCE/DOM/dommsk.F90
r13237 r13286 26 26 USE oce ! ocean dynamics and tracers 27 27 USE dom_oce ! ocean space and time domain 28 USE domutl ! 28 29 USE usrdef_fmask ! user defined fmask 29 30 USE bdy_oce ! open boundary … … 89 90 ! 90 91 INTEGER :: ji, jj, jk ! dummy loop indices 91 INTEGER :: iif, iil ! local integers92 INTEGER :: ijf, ijl ! - -93 92 INTEGER :: iktop, ikbot ! - - 94 93 INTEGER :: ios, inum … … 136 135 ikbot = k_bot(ji,jj) 137 136 IF( iktop /= 0 ) THEN ! water in the column 138 tmask(ji,jj,iktop:ikbot 137 tmask(ji,jj,iktop:ikbot) = 1._wp 139 138 ENDIF 140 139 END_2D 141 140 ! 142 ! the following call is mandatory 143 ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...) 144 CALL lbc_lnk( 'dommsk', tmask , 'T', 1._wp ) ! Lateral boundary conditions 145 146 ! Mask corrections for bdy (read in mppini2) 141 ! Mask corrections for bdy (read in mppini2) 147 142 READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 148 143 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist' ) … … 152 147 IF ( ln_bdy .AND. ln_mask_file ) THEN 153 148 CALL iom_open( cn_mask_file, inum ) 154 CALL iom_get ( inum, jpdom_ data, 'bdy_msk', bdytmask(:,:) )149 CALL iom_get ( inum, jpdom_global, 'bdy_msk', bdytmask(:,:) ) 155 150 CALL iom_close( inum ) 156 151 DO_3D_11_11( 1, jpkm1 ) … … 162 157 ! ---------------------------------------- 163 158 ! NB: at this point, fmask is designed for free slip lateral boundary condition 164 DO jk = 1, jpk 165 DO jj = 1, jpjm1 166 DO ji = 1, jpim1 ! vector loop 167 umask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji+1,jj ,jk) 168 vmask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji ,jj+1,jk) 169 END DO 170 DO ji = 1, jpim1 ! NO vector opt. 171 fmask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji+1,jj ,jk) & 172 & * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 173 END DO 174 END DO 175 END DO 159 DO_3D_00_00( 1, jpk ) 160 umask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji+1,jj ,jk) 161 vmask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji ,jj+1,jk) 162 fmask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji+1,jj ,jk) & 163 & * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 164 END_3D 176 165 CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1.0_wp, vmask, 'V', 1.0_wp, fmask, 'F', 1.0_wp ) ! Lateral boundary conditions 177 166 … … 187 176 END DO 188 177 189 190 178 ! Ocean/land column mask at t-, u-, and v-points (i.e. at least 1 wet cell in the vertical) 191 179 ! ---------------------------------------------- … … 195 183 ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 196 184 197 198 185 ! Interior domain mask (used for global sum) 199 186 ! -------------------- 200 187 ! 201 iif = nn_hls ; iil = nlci - nn_hls + 1 202 ijf = nn_hls ; ijl = nlcj - nn_hls + 1 203 ! 204 ! ! halo mask : 0 on the halo and 1 elsewhere 205 tmask_h(:,:) = 1._wp 206 tmask_h( 1 :iif, : ) = 0._wp ! first columns 207 tmask_h(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns) 208 tmask_h( : , 1 :ijf) = 0._wp ! first rows 209 tmask_h( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows) 210 ! 211 ! ! north fold mask 212 tpol(1:jpiglo) = 1._wp 213 fpol(1:jpiglo) = 1._wp 214 IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot 215 tpol(jpiglo/2+1:jpiglo) = 0._wp 216 fpol( 1 :jpiglo) = 0._wp 217 IF( mjg(nlej) == jpjglo ) THEN ! only half of the nlcj-1 row for tmask_h 218 DO ji = iif+1, iil-1 219 tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 220 END DO 221 ENDIF 222 ENDIF 223 ! 224 IF( jperio == 5 .OR. jperio == 6 ) THEN ! F-point pivot 225 tpol( 1 :jpiglo) = 0._wp 226 fpol(jpiglo/2+1:jpiglo) = 0._wp 227 ENDIF 188 CALL dom_uniq( tmask_h, 'T' ) 228 189 ! 229 190 ! ! interior mask : 2D ocean mask x halo mask 230 191 tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 231 232 192 233 193 ! Lateral boundary conditions on velocity (modify fmask) -
NEMO/trunk/src/OCE/DOM/domqco.F90
r13237 r13286 217 217 ! 218 218 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 219 CALL iom_get( numror, jpdom_auto glo, 'sshb' , ssh(:,:,Kbb), ldxios = lrxios )220 CALL iom_get( numror, jpdom_auto glo, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios )219 CALL iom_get( numror, jpdom_auto, 'sshb' , ssh(:,:,Kbb), ldxios = lrxios ) 220 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 221 221 ! needed to restart if land processor not computed 222 222 IF(lwp) write(numout,*) 'qe_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files' … … 232 232 IF(lwp) write(numout,*) 'sshn set equal to sshb.' 233 233 IF(lwp) write(numout,*) 'neuler is forced to 0' 234 CALL iom_get( numror, jpdom_auto glo, 'sshb', ssh(:,:,Kbb), ldxios = lrxios )234 CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb), ldxios = lrxios ) 235 235 ssh(:,:,Kmm) = ssh(:,:,Kbb) 236 236 l_1st_euler = .TRUE. … … 239 239 IF(lwp) write(numout,*) 'sshb set equal to sshn.' 240 240 IF(lwp) write(numout,*) 'neuler is forced to 0' 241 CALL iom_get( numror, jpdom_auto glo, 'sshn', ssh(:,:,Kmm), ldxios = lrxios )241 CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm), ldxios = lrxios ) 242 242 ssh(:,:,Kbb) = ssh(:,:,Kmm) 243 243 l_1st_euler = .TRUE. -
NEMO/trunk/src/OCE/DOM/domvvl.F90
r13237 r13286 273 273 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 274 274 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 275 ii0 = 103 ; ii1 = 111276 ij0 = 128 ; ij1 = 135 ;275 ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 276 ij0 = 128 + nn_hls ; ij1 = 135 + nn_hls 277 277 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 278 278 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt … … 805 805 IF( ln_rstart ) THEN !* Read the restart file 806 806 CALL rst_read_open ! open the restart file if necessary 807 CALL iom_get( numror, jpdom_auto glo, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios )807 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 808 808 ! 809 809 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 818 818 ! 819 819 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 820 CALL iom_get( numror, jpdom_auto glo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )821 CALL iom_get( numror, jpdom_auto glo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )820 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 821 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 822 822 ! needed to restart if land processor not computed 823 823 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 833 833 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 834 834 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 835 CALL iom_get( numror, jpdom_auto glo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )835 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 836 836 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 837 837 l_1st_euler = .true. … … 840 840 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 841 841 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 842 CALL iom_get( numror, jpdom_auto glo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )842 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 843 843 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 844 844 l_1st_euler = .true. … … 865 865 ! ! ----------------------- ! 866 866 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 867 CALL iom_get( numror, jpdom_auto glo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios )868 CALL iom_get( numror, jpdom_auto glo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios )867 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 868 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 869 869 ELSE ! one at least array is missing 870 870 tilde_e3t_b(:,:,:) = 0.0_wp … … 875 875 ! ! ------------ ! 876 876 IF( id5 > 0 ) THEN ! required array exists 877 CALL iom_get( numror, jpdom_auto glo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios )877 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 878 878 ELSE ! array is missing 879 879 hdiv_lf(:,:,:) = 0.0_wp -
NEMO/trunk/src/OCE/DOM/domwri.F90
r13226 r13286 13 13 !!---------------------------------------------------------------------- 14 14 !! dom_wri : create and write mesh and mask file(s) 15 !! dom_uniq : identify unique point of a grid (TUVF)16 15 !! dom_stiff : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate) 17 16 !!---------------------------------------------------------------------- 18 17 ! 19 18 USE dom_oce ! ocean space and time domain 19 USE domutl ! 20 20 USE phycst , ONLY : rsmall 21 21 USE wet_dry, ONLY : ll_wd ! Wetting and drying … … 74 74 ! ! ============================ 75 75 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 76 !77 ! ! global domain size78 CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )79 CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )80 CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpkglo, wp), ktype = jp_i4 )81 82 76 ! ! domain characteristics 83 77 CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) … … 182 176 ! ! ============================ 183 177 END SUBROUTINE dom_wri 184 185 186 SUBROUTINE dom_uniq( puniq, cdgrd )187 !!----------------------------------------------------------------------188 !! *** ROUTINE dom_uniq ***189 !!190 !! ** Purpose : identify unique point of a grid (TUVF)191 !!192 !! ** Method : 1) aplly lbc_lnk on an array with different values for each element193 !! 2) check which elements have been changed194 !!----------------------------------------------------------------------195 CHARACTER(len=1) , INTENT(in ) :: cdgrd !196 REAL(wp), DIMENSION(:,:), INTENT(inout) :: puniq !197 !198 REAL(wp) :: zshift ! shift value link to the process number199 INTEGER :: ji ! dummy loop indices200 LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) :: lldbl ! store whether each point is unique or not201 REAL(wp), DIMENSION(jpi,jpj) :: ztstref202 !!----------------------------------------------------------------------203 !204 ! build an array with different values for each element205 ! in mpp: make sure that these values are different even between process206 ! -> apply a shift value according to the process number207 zshift = jpi * jpj * ( narea - 1 )208 ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )209 !210 puniq(:,:) = ztstref(:,:) ! default definition211 CALL lbc_lnk( 'domwri', puniq, cdgrd, 1.0_wp ) ! apply boundary conditions212 lldbl(:,:,1) = puniq(:,:) == ztstref(:,:) ! check which values have been changed213 !214 puniq(:,:) = 1. ! default definition215 ! fill only the inner part of the cpu with llbl converted into real216 puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp )217 !218 END SUBROUTINE dom_uniq219 178 220 179 -
NEMO/trunk/src/OCE/DOM/domzgr.F90
r13226 r13286 75 75 INTEGER :: ioptio, ibat, ios ! local integer 76 76 REAL(wp) :: zrefdep ! depth of the reference level (~10m) 77 REAL(wp), DIMENSION(jpi,jpj) :: zmsk 77 78 !!---------------------------------------------------------------------- 78 79 ! … … 109 110 ! 110 111 ENDIF 112 ! 113 ! the following is mandatory 114 ! make sure that closed boundaries are correctly defined in k_top that will be used to compute all mask arrays 115 ! 116 zmsk(:,:) = 1._wp ! default: no closed boundaries 117 IF( jperio == 0 .OR. jperio == 2 .OR. jperio == 3 .OR. jperio == 5 ) THEN ! E-W closed 118 zmsk( mi0( 1+nn_hls):mi1( 1+nn_hls),:) = 0._wp ! first column of inner global domain at 0 119 zmsk( mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = 0._wp ! last column of inner global domain at 0 120 ENDIF 121 IF( .NOT. ( jperio == 2 .OR. jperio == 7 ) ) THEN ! S closed 122 zmsk(:,mj0( 1+nn_hls):mj1( 1+nn_hls) ) = 0._wp ! first line of inner global domain at 0 123 ENDIF 124 IF( jperio == 0 .OR. jperio == 1 ) THEN ! N closed 125 zmsk(:,mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls) ) = 0._wp ! last line of inner global domain at 0 126 ENDIF 127 CALL lbc_lnk( 'usrdef_zgr', zmsk, 'T', 1. ) ! set halos 128 k_top(:,:) = k_top(:,:) * NINT( zmsk(:,:) ) 111 129 ! 112 130 !!gm to be remove when removing the OLD definition of e3 scale factors so that gde3w disappears … … 164 182 !!gm end bug 165 183 ! 166 IF( nprint == 1 .AND.lwp ) THEN184 IF( lwp ) THEN 167 185 WRITE(numout,*) ' MIN val k_top ', MINVAL( k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) ) 168 186 WRITE(numout,*) ' MIN val k_bot ', MINVAL( k_bot(:,:) ), ' MAX ', MAXVAL( k_bot(:,:) ) … … 236 254 CALL iom_get( inum, jpdom_unknown, 'e3w_1d' , pe3w_1d ) 237 255 ! 238 CALL iom_get( inum, jpdom_ data, 'e3t_0' , pe3t , lrowattr=ln_use_jattr) ! 3D coordinate239 CALL iom_get( inum, jpdom_ data, 'e3u_0' , pe3u , lrowattr=ln_use_jattr)240 CALL iom_get( inum, jpdom_ data, 'e3v_0' , pe3v , lrowattr=ln_use_jattr)241 CALL iom_get( inum, jpdom_ data, 'e3f_0' , pe3f , lrowattr=ln_use_jattr)242 CALL iom_get( inum, jpdom_ data, 'e3w_0' , pe3w , lrowattr=ln_use_jattr)243 CALL iom_get( inum, jpdom_ data, 'e3uw_0' , pe3uw , lrowattr=ln_use_jattr)244 CALL iom_get( inum, jpdom_ data, 'e3vw_0' , pe3vw , lrowattr=ln_use_jattr)256 CALL iom_get( inum, jpdom_global, 'e3t_0' , pe3t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy ) ! 3D coordinate 257 CALL iom_get( inum, jpdom_global, 'e3u_0' , pe3u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 258 CALL iom_get( inum, jpdom_global, 'e3v_0' , pe3v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 259 CALL iom_get( inum, jpdom_global, 'e3f_0' , pe3f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy ) 260 CALL iom_get( inum, jpdom_global, 'e3w_0' , pe3w , cd_type = 'W', psgn = 1._wp, kfill = jpfillcopy ) 261 CALL iom_get( inum, jpdom_global, 'e3uw_0' , pe3uw, cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 262 CALL iom_get( inum, jpdom_global, 'e3vw_0' , pe3vw, cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 245 263 ! 246 264 ! !* depths … … 254 272 CALL iom_get( inum, jpdom_unknown, 'gdept_1d', pdept_1d ) 255 273 CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', pdepw_1d ) 256 CALL iom_get( inum, jpdom_ data , 'gdept_0' , pdept , lrowattr=ln_use_jattr)257 CALL iom_get( inum, jpdom_ data , 'gdepw_0' , pdepw , lrowattr=ln_use_jattr)274 CALL iom_get( inum, jpdom_global , 'gdept_0' , pdept, kfill = jpfillcopy ) 275 CALL iom_get( inum, jpdom_global , 'gdepw_0' , pdepw, kfill = jpfillcopy ) 258 276 ! 259 277 ELSE !- depths computed from e3. scale factors … … 269 287 ! 270 288 ! !* ocean top and bottom level 271 CALL iom_get( inum, jpdom_ data, 'top_level' , z2d , lrowattr=ln_use_jattr) ! 1st wet T-points (ISF)289 CALL iom_get( inum, jpdom_global, 'top_level' , z2d ) ! 1st wet T-points (ISF) 272 290 k_top(:,:) = NINT( z2d(:,:) ) 273 CALL iom_get( inum, jpdom_ data, 'bottom_level' , z2d , lrowattr=ln_use_jattr) ! last wet T-points291 CALL iom_get( inum, jpdom_global, 'bottom_level' , z2d ) ! last wet T-points 274 292 k_bot(:,:) = NINT( z2d(:,:) ) 275 293 ! -
NEMO/trunk/src/OCE/DOM/dtatsd.F90
r12377 r13286 153 153 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 154 154 ! 155 ij0 = 101 ; ij1 = 109! Reduced T & S in the Alboran Sea156 ii0 = 141 ; ii1 = 155155 ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea 156 ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1 157 157 DO jj = mj0(ij0), mj1(ij1) 158 158 DO ji = mi0(ii0), mi1(ii1) … … 167 167 END DO 168 168 END DO 169 ij0 = 87 ; ij1 = 96! Reduced temperature in Red Sea170 ii0 = 148 ; ii1 = 160169 ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea 170 ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 171 171 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 172 172 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
Note: See TracChangeset
for help on using the changeset viewer.
