Changeset 13286 for NEMO/trunk/src/OCE/DOM/domain.F90
- Timestamp:
- 2020-07-09T17:48:29+02:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DOM/domain.F90 (modified) (10 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/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 !
Note: See TracChangeset
for help on using the changeset viewer.
