- Timestamp:
- 2021-12-03T20:32:50+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14318_RK3_stage1
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DOM/domain.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14318_RK3_stage1
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette@14244 sette 11 ^/utils/CI/sette@HEAD sette 12
-
- Property svn:externals
-
NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/DOM/domain.F90
r14547 r15574 11 11 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 12 12 !! 2.0 ! 2005-11 (V. Garnier) Surface pressure gradient organization 13 !! 3.3 ! 2010-11 (G. Madec) initialisation in C1D configuration 13 !! 3.3 ! 2010-11 (G. Madec) initialisation in C1D configuration 14 14 !! 3.6 ! 2013 ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs 15 15 !! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default … … 20 20 !!---------------------------------------------------------------------- 21 21 !! dom_init : initialize the space and time domain 22 !! dom_glo : initialize global domain <--> local domain indices23 22 !! dom_nam : read and contral domain namelists 24 23 !! dom_ctl : control print for the ocean domain … … 46 45 USE dommsk ! domain: set the mask system 47 46 USE domwri ! domain: write the meshmask file 48 USE c1d ! 1D configuration49 USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine)50 47 USE wet_dry , ONLY : ll_wd ! wet & drying flag 51 48 USE closea , ONLY : dom_clo ! closed seas routine 49 USE c1d 52 50 ! 53 51 USE in_out_manager ! I/O manager … … 112 110 WRITE(numout,*) ' jpnj : ', jpnj, ' nn_hls : ', nn_hls 113 111 WRITE(numout,*) ' jpnij : ', jpnij 114 WRITE(numout,*) ' lateral boundary of the Global domain : jperio = ', jperio 115 SELECT CASE ( jperio ) 116 CASE( 0 ) ; WRITE(numout,*) ' (i.e. closed)' 117 CASE( 1 ) ; WRITE(numout,*) ' (i.e. cyclic east-west)' 118 CASE( 2 ) ; WRITE(numout,*) ' (i.e. cyclic north-south)' 119 CASE( 3 ) ; WRITE(numout,*) ' (i.e. north fold with T-point pivot)' 120 CASE( 4 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north fold with T-point pivot)' 121 CASE( 5 ) ; WRITE(numout,*) ' (i.e. north fold with F-point pivot)' 122 CASE( 6 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north fold with F-point pivot)' 123 CASE( 7 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north-south)' 124 CASE DEFAULT 125 CALL ctl_stop( 'dom_init: jperio is out of range' ) 126 END SELECT 112 WRITE(numout,*) ' lateral boundary of the Global domain:' 113 WRITE(numout,*) ' cyclic east-west :', l_Iperio 114 WRITE(numout,*) ' cyclic north-south :', l_Jperio 115 WRITE(numout,*) ' North Pole folding :', l_NFold 116 WRITE(numout,*) ' type of North pole Folding:', c_NFtype 127 117 WRITE(numout,*) ' Ocean model configuration used:' 128 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg118 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 129 119 ENDIF 130 120 … … 132 122 ! !== Reference coordinate system ==! 133 123 ! 134 CALL dom_ glo ! global domain versus local domain135 CALL dom_ nam ! read namelist ( namrun, namdom )136 CALL dom_tile( ntsi, ntsj, ntei, ntej ) ! Tile domain 137 124 CALL dom_nam ! read namelist ( namrun, namdom ) 125 CALL dom_tile_init ! Tile domain 126 127 IF( ln_c1d ) CALL c1d_init ! 1D column configuration 138 128 ! 139 129 CALL dom_hgr ! Horizontal mesh … … 155 145 END DO 156 146 ! 157 DO jk = 1, jpkm1158 hf_0( 1:jpim1,:) = hf_0(1:jpim1,:) + e3f_0(1:jpim1,:,jk)*vmask(1:jpim1,:,jk)*vmask(2:jpi,:,jk)159 END DO147 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 148 hf_0(ji,jj) = hf_0(ji,jj) + e3f_0(ji,jj,jk)*vmask(ji,jj,jk)*vmask(ji+1,jj,jk) 149 END_3D 160 150 CALL lbc_lnk('domain', hf_0, 'F', 1._wp) 161 151 ! … … 235 225 ! 236 226 237 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point238 !239 240 227 #if defined key_agrif 241 228 IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa ) … … 254 241 ! 255 242 END SUBROUTINE dom_init 256 257 258 SUBROUTINE dom_glo259 !!----------------------------------------------------------------------260 !! *** ROUTINE dom_glo ***261 !!262 !! ** Purpose : initialization of global domain <--> local domain indices263 !!264 !! ** Method :265 !!266 !! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices267 !! - mig0, mjg0: local domain indices ==> global domain, excluding halos, indices268 !! - mi0 , mi1 : global domain indices ==> local domain indices269 !! - mj0 , mj1 (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)270 !!----------------------------------------------------------------------271 INTEGER :: ji, jj ! dummy loop argument272 !!----------------------------------------------------------------------273 !274 DO ji = 1, jpi ! local domain indices ==> global domain indices, including halos275 mig(ji) = ji + nimpp - 1276 END DO277 DO jj = 1, jpj278 mjg(jj) = jj + njmpp - 1279 END DO280 ! ! local domain indices ==> global domain indices, excluding halos281 !282 mig0(:) = mig(:) - nn_hls283 mjg0(:) = mjg(:) - nn_hls284 ! ! global domain, including halos, indices ==> local domain indices285 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the286 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.287 DO ji = 1, jpiglo288 mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )289 mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi ) )290 END DO291 DO jj = 1, jpjglo292 mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )293 mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj ) )294 END DO295 IF(lwp) THEN ! control print296 WRITE(numout,*)297 WRITE(numout,*) 'dom_glo : domain: global <<==>> local '298 WRITE(numout,*) '~~~~~~~ '299 WRITE(numout,*) ' global domain: jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo300 WRITE(numout,*) ' local domain: jpi = ', jpi , ' jpj = ', jpj , ' jpk = ', jpk301 WRITE(numout,*)302 ENDIF303 !304 END SUBROUTINE dom_glo305 243 306 244 … … 327 265 & nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, ln_1st_euler , & 328 266 & ln_cfmeta, ln_xios_read, nn_wxios 329 NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_ meshmask267 NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_c1d, ln_meshmask 330 268 NAMELIST/namtile/ ln_tile, nn_ltile_i, nn_ltile_j 331 269 #if defined key_netcdf4 … … 368 306 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 369 307 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 308 WRITE(numout,*) ' single column domain (1x1pt) ln_c1d = ', ln_c1d 370 309 ENDIF 371 310 ! … … 640 579 641 580 642 SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio)581 SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, ldIperio, ldJperio, ldNFold, cdNFtype ) 643 582 !!---------------------------------------------------------------------- 644 583 !! *** ROUTINE domain_cfg *** … … 648 587 !! ** Method : read the cn_domcfg NetCDF file 649 588 !!---------------------------------------------------------------------- 650 CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name 651 INTEGER , INTENT(out) :: kk_cfg ! configuration resolution 652 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 653 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. 654 ! 655 INTEGER :: inum ! local integer 589 CHARACTER(len=*), INTENT(out) :: cd_cfg ! configuration name 590 INTEGER , INTENT(out) :: kk_cfg ! configuration resolution 591 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 592 LOGICAL , INTENT(out) :: ldIperio, ldJperio ! i- and j- periodicity 593 LOGICAL , INTENT(out) :: ldNFold ! North pole folding 594 CHARACTER(len=1), INTENT(out) :: cdNFtype ! Folding type: T or F 595 ! 596 CHARACTER(len=7) :: catt ! 'T', 'F', '-' or 'UNKNOWN' 597 INTEGER :: inum, iperio, iatt ! local integer 656 598 REAL(wp) :: zorca_res ! local scalars 657 599 REAL(wp) :: zperio ! - - … … 667 609 CALL iom_open( cn_domcfg, inum ) 668 610 ! 669 ! !- ORCA family specificity 670 IF( iom_varid( inum, 'ORCA' , ldstop = .FALSE. ) > 0 .AND. & 671 & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0 ) THEN 672 ! 673 cd_cfg = 'ORCA' 674 CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = NINT( zorca_res ) 675 ! 676 IF(lwp) THEN 677 WRITE(numout,*) ' .' 678 WRITE(numout,*) ' ==>>> ORCA configuration ' 679 WRITE(numout,*) ' .' 611 CALL iom_getatt( inum, 'CfgName', cd_cfg ) ! returns 'UNKNOWN' if not found 612 CALL iom_getatt( inum, 'CfgIndex', kk_cfg ) ! returns -999 if not found 613 ! 614 ! ------- keep compatibility with OLD VERSION... start ------- 615 IF( cd_cfg == 'UNKNOWN' .AND. kk_cfg == -999 ) THEN 616 IF( iom_varid( inum, 'ORCA' , ldstop = .FALSE. ) > 0 .AND. & 617 & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0 ) THEN 618 ! 619 cd_cfg = 'ORCA' 620 CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = NINT( zorca_res ) 621 ! 622 ELSE 623 CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns 'UNKNOWN' if not found 624 CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found 680 625 ENDIF 681 ! 682 ELSE !- cd_cfg & k_cfg are not used 683 cd_cfg = 'UNKNOWN' 684 kk_cfg = -9999999 685 !- or they may be present as global attributes 686 !- (netcdf only) 687 CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found 688 CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found 689 IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN' 690 IF( kk_cfg == -999 ) kk_cfg = -9999999 691 ! 692 ENDIF 693 ! 626 ENDIF 627 ! ------- keep compatibility with OLD VERSION... end ------- 628 ! 694 629 idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz ) ! use e3t_0, that must exist, to get jp(ijk)glo 695 630 kpi = idimsz(1) 696 631 kpj = idimsz(2) 697 632 kpk = idimsz(3) 698 CALL iom_get( inum, 'jperio', zperio ) ; kperio = NINT( zperio ) 633 ! 634 CALL iom_getatt( inum, 'Iperio', iatt ) ; ldIperio = iatt == 1 ! returns -999 if not found -> default = .false. 635 CALL iom_getatt( inum, 'Jperio', iatt ) ; ldJperio = iatt == 1 ! returns -999 if not found -> default = .false. 636 CALL iom_getatt( inum, 'NFold', iatt ) ; ldNFold = iatt == 1 ! returns -999 if not found -> default = .false. 637 CALL iom_getatt( inum, 'NFtype', catt ) ! returns 'UNKNOWN' if not found 638 IF( LEN_TRIM(catt) == 1 ) THEN ; cdNFtype = TRIM(catt) 639 ELSE ; cdNFtype = '-' 640 ENDIF 641 ! 642 ! ------- keep compatibility with OLD VERSION... start ------- 643 IF( iatt == -999 .AND. catt == 'UNKNOWN' .AND. iom_varid( inum, 'jperio', ldstop = .FALSE. ) > 0 ) THEN 644 CALL iom_get( inum, 'jperio', zperio ) ; iperio = NINT( zperio ) 645 ldIperio = iperio == 1 .OR. iperio == 4 .OR. iperio == 6 .OR. iperio == 7 ! i-periodicity 646 ldJperio = iperio == 2 .OR. iperio == 7 ! j-periodicity 647 ldNFold = iperio >= 3 .AND. iperio <= 6 ! North pole folding 648 IF( iperio == 3 .OR. iperio == 4 ) THEN ; cdNFtype = 'T' ! folding at T point 649 ELSEIF( iperio == 5 .OR. iperio == 6 ) THEN ; cdNFtype = 'F' ! folding at F point 650 ELSE ; cdNFtype = '-' ! default value 651 ENDIF 652 ENDIF 653 ! ------- keep compatibility with OLD VERSION... end ------- 654 ! 699 655 CALL iom_close( inum ) 700 656 ! 701 657 IF(lwp) THEN 702 WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg 658 WRITE(numout,*) ' .' 659 WRITE(numout,*) ' ==>>> ', TRIM(cn_cfg), ' configuration ' 660 WRITE(numout,*) ' .' 661 WRITE(numout,*) ' nn_cfg = ', kk_cfg 703 662 WRITE(numout,*) ' Ni0glo = ', kpi 704 663 WRITE(numout,*) ' Nj0glo = ', kpj 705 664 WRITE(numout,*) ' jpkglo = ', kpk 706 WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio707 665 ENDIF 708 666 ! … … 742 700 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 743 701 ! 744 ! !== ORCA family specificities ==! 745 IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 746 CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 ) 747 CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 748 ENDIF 702 ! !== Configuration specificities ==! 703 ! 704 CALL iom_putatt( inum, 'CfgName', TRIM(cn_cfg) ) 705 CALL iom_putatt( inum, 'CfgIndex', nn_cfg ) 749 706 ! 750 707 ! !== domain characteristics ==! 751 708 ! 752 709 ! ! lateral boundary of the global domain 753 CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 754 ! 710 CALL iom_putatt( inum, 'Iperio', COUNT( (/l_Iperio/) ) ) 711 CALL iom_putatt( inum, 'Jperio', COUNT( (/l_Jperio/) ) ) 712 CALL iom_putatt( inum, 'NFold', COUNT( (/l_NFold /) ) ) 713 CALL iom_putatt( inum, 'NFtype', c_NFtype ) 714 755 715 ! ! type of vertical coordinate 756 CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4)757 CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4)758 CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4)759 !716 IF(ln_zco) CALL iom_putatt( inum, 'VertCoord', 'zco' ) 717 IF(ln_zps) CALL iom_putatt( inum, 'VertCoord', 'zps' ) 718 IF(ln_sco) CALL iom_putatt( inum, 'VertCoord', 'sco' ) 719 760 720 ! ! ocean cavities under iceshelves 761 CALL iom_ rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4)721 CALL iom_putatt( inum, 'IsfCav', COUNT( (/ln_isfcav/) ) ) 762 722 ! 763 723 ! !== horizontal mesh ! … … 812 772 CALL iom_rstput( 0, 0, inum, 'ht_0' , ht_0 , ktype = jp_r8 ) 813 773 ENDIF 814 ! 815 ! Add some global attributes ( netcdf only ) 816 CALL iom_putatt( inum, 'nn_cfg', nn_cfg ) 817 CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) ) 818 ! 819 ! ! ============================ 820 ! ! close the files 821 ! ! ============================ 774 ! ! ============================ ! 775 ! ! close the files 776 ! ! ============================ ! 822 777 CALL iom_close( inum ) 823 778 !
Note: See TracChangeset
for help on using the changeset viewer.
