Changeset 13458 for NEMO/trunk/src/SWE/domain.F90
- Timestamp:
- 2020-09-11T11:22:24+02:00 (4 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/SWE/domain.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/SWE/domain.F90
r13435 r13458 245 245 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 246 246 ! 247 248 #if defined key_agrif 249 IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa ) 250 #endif 247 251 IF( ln_meshmask ) CALL dom_wri ! Create a domain file 248 249 252 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 250 253 ! … … 269 272 !! ** Method : 270 273 !! 271 !! ** Action : - mig , mjg : local domain indices ==> global domain indices 274 !! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices 275 !! - mig0, mjg0: local domain indices ==> global domain, excluding halos, indices 272 276 !! - mi0 , mi1 : global domain indices ==> local domain indices 273 !! - mj0 ,, mj1 (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)277 !! - mj0 , mj1 (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 274 278 !!---------------------------------------------------------------------- 275 279 INTEGER :: ji, jj ! dummy loop argument 276 280 !!---------------------------------------------------------------------- 277 281 ! 278 DO ji = 1, jpi ! local domain indices ==> global domain indices 282 DO ji = 1, jpi ! local domain indices ==> global domain indices, including halos 279 283 mig(ji) = ji + nimpp - 1 280 284 END DO … … 282 286 mjg(jj) = jj + njmpp - 1 283 287 END DO 284 ! ! global domain indices ==> local domain indices 288 ! ! local domain indices ==> global domain indices, excluding halos 289 ! 290 mig0(:) = mig(:) - nn_hls 291 mjg0(:) = mjg(:) - nn_hls 292 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 293 ! we must define mig0 and mjg0 as bellow. 294 ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 295 mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 296 mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 297 ! 298 ! ! global domain, including halos, indices ==> local domain indices 285 299 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 286 300 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. … … 300 314 WRITE(numout,*) ' local domain: jpi = ', jpi , ' jpj = ', jpj , ' jpk = ', jpk 301 315 WRITE(numout,*) 302 WRITE(numout,*) ' conversion from local to global domain indices (and vise versa) done' 303 IF( nn_print >= 1 ) THEN 304 WRITE(numout,*) 305 WRITE(numout,*) ' conversion local ==> global i-index domain (mig)' 306 WRITE(numout,25) (mig(ji),ji = 1,jpi) 307 WRITE(numout,*) 308 WRITE(numout,*) ' conversion global ==> local i-index domain' 309 WRITE(numout,*) ' starting index (mi0)' 310 WRITE(numout,25) (mi0(ji),ji = 1,jpiglo) 311 WRITE(numout,*) ' ending index (mi1)' 312 WRITE(numout,25) (mi1(ji),ji = 1,jpiglo) 313 WRITE(numout,*) 314 WRITE(numout,*) ' conversion local ==> global j-index domain (mjg)' 315 WRITE(numout,25) (mjg(jj),jj = 1,jpj) 316 WRITE(numout,*) 317 WRITE(numout,*) ' conversion global ==> local j-index domain' 318 WRITE(numout,*) ' starting index (mj0)' 319 WRITE(numout,25) (mj0(jj),jj = 1,jpjglo) 320 WRITE(numout,*) ' ending index (mj1)' 321 WRITE(numout,25) (mj1(jj),jj = 1,jpjglo) 322 ENDIF 323 ENDIF 324 25 FORMAT( 100(10x,19i4,/) ) 316 ENDIF 325 317 ! 326 318 END SUBROUTINE dom_glo … … 364 356 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist' ) 365 357 IF(lwm) WRITE ( numond, namrun ) 358 359 #if defined key_agrif 360 IF( .NOT. Agrif_Root() ) THEN 361 nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1 362 nn_itend = Agrif_Parent(nn_itend) *Agrif_IRhot() 363 ENDIF 364 #endif 366 365 ! 367 366 IF(lwp) THEN ! control print … … 435 434 #endif 436 435 437 #if defined key_agrif438 436 IF( Agrif_Root() ) THEN 439 #endif 440 IF(lwp) WRITE(numout,*) 441 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 442 CASE ( 1 ) 443 CALL ioconf_calendar('gregorian') 444 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year' 445 CASE ( 0 ) 446 CALL ioconf_calendar('noleap') 447 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year' 448 CASE ( 30 ) 449 CALL ioconf_calendar('360d') 450 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year' 451 END SELECT 452 #if defined key_agrif 453 ENDIF 454 #endif 437 IF(lwp) WRITE(numout,*) 438 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 439 CASE ( 1 ) 440 CALL ioconf_calendar('gregorian') 441 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year' 442 CASE ( 0 ) 443 CALL ioconf_calendar('noleap') 444 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year' 445 CASE ( 30 ) 446 CALL ioconf_calendar('360d') 447 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year' 448 END SELECT 449 ENDIF 455 450 456 451 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) … … 459 454 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 460 455 IF(lwm) WRITE( numond, namdom ) 456 ! 457 #if defined key_agrif 458 IF( .NOT. Agrif_Root() ) THEN 459 rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot() 460 ENDIF 461 #endif 461 462 ! 462 463 IF(lwp) THEN … … 519 520 !! ** Method : compute and print extrema of masked scale factors 520 521 !!---------------------------------------------------------------------- 521 INTEGER, DIMENSION(2) :: imi1, imi2, ima1, ima2 522 INTEGER, DIMENSION(2) :: iloc ! 523 REAL(wp) :: ze1min, ze1max, ze2min, ze2max 524 !!---------------------------------------------------------------------- 525 ! 526 IF(lk_mpp) THEN 527 CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 528 CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 529 CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 530 CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 531 ELSE 532 ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 533 ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 534 ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 535 ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 536 ! 537 iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 538 imi1(1) = iloc(1) + nimpp - 1 539 imi1(2) = iloc(2) + njmpp - 1 540 iloc = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 541 imi2(1) = iloc(1) + nimpp - 1 542 imi2(2) = iloc(2) + njmpp - 1 543 iloc = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 544 ima1(1) = iloc(1) + nimpp - 1 545 ima1(2) = iloc(2) + njmpp - 1 546 iloc = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 547 ima2(1) = iloc(1) + nimpp - 1 548 ima2(2) = iloc(2) + njmpp - 1 549 ENDIF 522 LOGICAL, DIMENSION(jpi,jpj) :: llmsk 523 INTEGER, DIMENSION(2) :: imil, imip, imi1, imi2, imal, imap, ima1, ima2 524 REAL(wp) :: zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max 525 !!---------------------------------------------------------------------- 526 ! 527 llmsk = tmask_h(:,:) == 1._wp 528 ! 529 CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil ) 530 CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip ) 531 CALL mpp_minloc( 'domain', e1t(:,:), llmsk, ze1min, imi1 ) 532 CALL mpp_minloc( 'domain', e2t(:,:), llmsk, ze2min, imi2 ) 533 CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal ) 534 CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap ) 535 CALL mpp_maxloc( 'domain', e1t(:,:), llmsk, ze1max, ima1 ) 536 CALL mpp_maxloc( 'domain', e2t(:,:), llmsk, ze2max, ima2 ) 537 ! 550 538 IF(lwp) THEN 551 539 WRITE(numout,*) 552 540 WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 553 541 WRITE(numout,*) '~~~~~~~' 554 WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 555 WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 556 WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 557 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 542 WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2) 543 WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2) 544 WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2) 545 WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2) 546 WRITE(numout,"(14x,' e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 547 WRITE(numout,"(14x,' e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 548 WRITE(numout,"(14x,' e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 549 WRITE(numout,"(14x,' e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 558 550 ENDIF 559 551 ! … … 622 614 IF(lwp) THEN 623 615 WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg 624 WRITE(numout,*) ' jpiglo = ', kpi625 WRITE(numout,*) ' jpjglo = ', kpj616 WRITE(numout,*) ' Ni0glo = ', kpi 617 WRITE(numout,*) ' Nj0glo = ', kpj 626 618 WRITE(numout,*) ' jpkglo = ', kpk 627 619 WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio … … 662 654 ! 663 655 clnam = cn_domcfg_out ! filename (configuration information) 664 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 665 656 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 666 657 ! 667 658 ! !== ORCA family specificities ==! … … 671 662 ENDIF 672 663 ! 673 ! !== global domain size ==!674 !675 CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )676 CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )677 CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk , wp), ktype = jp_i4 )678 !679 664 ! !== domain characteristics ==! 680 665 ! … … 683 668 ! 684 669 ! ! type of vertical coordinate 685 IF( ln_zco ) THEN ; izco = 1 ; ELSE ; izco = 0 ; ENDIF 686 IF( ln_zps ) THEN ; izps = 1 ; ELSE ; izps = 0 ; ENDIF 687 IF( ln_sco ) THEN ; isco = 1 ; ELSE ; isco = 0 ; ENDIF 688 CALL iom_rstput( 0, 0, inum, 'ln_zco' , REAL( izco, wp), ktype = jp_i4 ) 689 CALL iom_rstput( 0, 0, inum, 'ln_zps' , REAL( izps, wp), ktype = jp_i4 ) 690 CALL iom_rstput( 0, 0, inum, 'ln_sco' , REAL( isco, wp), ktype = jp_i4 ) 670 CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 ) 671 CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 ) 672 CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 ) 691 673 ! 692 674 ! ! ocean cavities under iceshelves 693 IF( ln_isfcav ) THEN ; icav = 1 ; ELSE ; icav = 0 ; ENDIF 694 CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 675 CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 ) 695 676 ! 696 677 ! !== horizontal mesh !
Note: See TracChangeset
for help on using the changeset viewer.
