- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DOM/domain.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/DOM/domain.F90
r13237 r13899 120 120 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 121 121 ENDIF 122 lwxios = .FALSE.123 ln_xios_read = .FALSE.124 122 ! 125 123 ! !== Reference coordinate system ==! … … 177 175 ! 178 176 IF( ln_linssh ) THEN != Fix in time : set to the reference one for all 179 !177 ! 180 178 DO jt = 1, jpt ! depth of t- and w-grid-points 181 179 gdept(:,:,:,jt) = gdept_0(:,:,:) … … 204 202 ELSE != time varying : initialize before/now/after variables 205 203 ! 206 IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa )204 IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa ) 207 205 ! 208 206 ENDIF … … 240 238 !! ** Method : 241 239 !! 242 !! ** Action : - mig , mjg : local domain indices ==> global domain indices 240 !! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices 241 !! - mig0, mjg0: local domain indices ==> global domain, excluding halos, indices 243 242 !! - mi0 , mi1 : global domain indices ==> local domain indices 244 !! - mj0 ,, mj1 (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)243 !! - mj0 , mj1 (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 245 244 !!---------------------------------------------------------------------- 246 245 INTEGER :: ji, jj ! dummy loop argument 247 246 !!---------------------------------------------------------------------- 248 247 ! 249 DO ji = 1, jpi ! local domain indices ==> global domain indices 248 DO ji = 1, jpi ! local domain indices ==> global domain indices, including halos 250 249 mig(ji) = ji + nimpp - 1 251 250 END DO … … 253 252 mjg(jj) = jj + njmpp - 1 254 253 END DO 255 ! ! global domain indices ==> local domain indices 254 ! ! local domain indices ==> global domain indices, excluding halos 255 ! 256 mig0(:) = mig(:) - nn_hls 257 mjg0(:) = mjg(:) - nn_hls 258 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 259 ! we must define mig0 and mjg0 as bellow. 260 ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 261 mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 262 mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 263 ! 264 ! ! global domain, including halos, indices ==> local domain indices 256 265 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 257 266 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. … … 271 280 WRITE(numout,*) ' local domain: jpi = ', jpi , ' jpj = ', jpj , ' jpk = ', jpk 272 281 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,/) ) 282 ENDIF 296 283 ! 297 284 END SUBROUTINE dom_glo … … 413 400 #endif 414 401 415 #if defined key_agrif416 402 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 403 IF(lwp) WRITE(numout,*) 404 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 405 CASE ( 1 ) 406 CALL ioconf_calendar('gregorian') 407 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year' 408 CASE ( 0 ) 409 CALL ioconf_calendar('noleap') 410 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year' 411 CASE ( 30 ) 412 CALL ioconf_calendar('360d') 413 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year' 414 END SELECT 415 ENDIF 433 416 434 417 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) … … 503 486 !! ** Method : compute and print extrema of masked scale factors 504 487 !!---------------------------------------------------------------------- 505 INTEGER, DIMENSION(2) :: imi1, imi2, ima1, ima2 506 INTEGER, DIMENSION(2) :: iloc ! 507 REAL(wp) :: ze1min, ze1max, ze2min, ze2max 508 !!---------------------------------------------------------------------- 509 ! 510 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 ) 515 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 488 LOGICAL, DIMENSION(jpi,jpj) :: llmsk 489 INTEGER, DIMENSION(2) :: imil, imip, imi1, imi2, imal, imap, ima1, ima2 490 REAL(wp) :: zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max 491 !!---------------------------------------------------------------------- 492 ! 493 llmsk = tmask_h(:,:) == 1._wp 494 ! 495 CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil ) 496 CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip ) 497 CALL mpp_minloc( 'domain', e1t(:,:), llmsk, ze1min, imi1 ) 498 CALL mpp_minloc( 'domain', e2t(:,:), llmsk, ze2min, imi2 ) 499 CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal ) 500 CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap ) 501 CALL mpp_maxloc( 'domain', e1t(:,:), llmsk, ze1max, ima1 ) 502 CALL mpp_maxloc( 'domain', e2t(:,:), llmsk, ze2max, ima2 ) 503 ! 534 504 IF(lwp) THEN 535 505 WRITE(numout,*) 536 506 WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 537 507 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) 508 WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2) 509 WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2) 510 WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2) 511 WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2) 512 WRITE(numout,"(14x,' e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 513 WRITE(numout,"(14x,' e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 514 WRITE(numout,"(14x,' e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 515 WRITE(numout,"(14x,' e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 542 516 ENDIF 543 517 ! … … 606 580 IF(lwp) THEN 607 581 WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg 608 WRITE(numout,*) ' jpiglo = ', kpi609 WRITE(numout,*) ' jpjglo = ', kpj582 WRITE(numout,*) ' Ni0glo = ', kpi 583 WRITE(numout,*) ' Nj0glo = ', kpj 610 584 WRITE(numout,*) ' jpkglo = ', kpk 611 585 WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio … … 631 605 !!---------------------------------------------------------------------- 632 606 INTEGER :: ji, jj, jk ! dummy loop indices 633 INTEGER :: izco, izps, isco, icav634 607 INTEGER :: inum ! local units 635 608 CHARACTER(len=21) :: clnam ! filename (mesh and mask informations) … … 646 619 ! 647 620 clnam = cn_domcfg_out ! filename (configuration information) 648 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 649 621 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 650 622 ! 651 623 ! !== ORCA family specificities ==! 652 IF( cn_cfg== "ORCA" ) THEN624 IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 653 625 CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 ) 654 626 CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 655 627 ENDIF 656 628 ! 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 629 ! !== domain characteristics ==! 664 630 ! … … 667 633 ! 668 634 ! ! 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 ) 635 CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 ) 636 CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 ) 637 CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 ) 675 638 ! 676 639 ! ! 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 ) 640 CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 ) 679 641 ! 680 642 ! !== horizontal mesh !
Note: See TracChangeset
for help on using the changeset viewer.
