Changeset 14072 for NEMO/trunk/src/OCE/DOM/domain.F90
- Timestamp:
- 2020-12-04T08:48:38+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DOM/domain.F90
r14053 r14072 6 6 !! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code 7 7 !! ! 1992-01 (M. Imbard) insert time step initialization 8 !! ! 1996-06 (G. Madec) generalized vertical coordinate 8 !! ! 1996-06 (G. Madec) generalized vertical coordinate 9 9 !! ! 1997-02 (G. Madec) creation of domwri.F 10 10 !! ! 2001-05 (E.Durand - G. Madec) insert closed sea … … 17 17 !! 4.1 ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 18 18 !!---------------------------------------------------------------------- 19 19 20 20 !!---------------------------------------------------------------------- 21 21 !! dom_init : initialize the space and time domain … … 33 33 USE domvvl ! variable volume 34 34 #endif 35 USE sshwzv , ONLY : ssh_init_rst ! set initial ssh 35 USE sshwzv , ONLY : ssh_init_rst ! set initial ssh 36 36 USE sbc_oce ! surface boundary condition: ocean 37 37 USE trc_oce ! shared ocean & passive tracers variab … … 72 72 !!---------------------------------------------------------------------- 73 73 !! *** ROUTINE dom_init *** 74 !! 75 !! ** Purpose : Domain initialization. Call the routines that are 76 !! required to create the arrays which define the space 74 !! 75 !! ** Purpose : Domain initialization. Call the routines that are 76 !! required to create the arrays which define the space 77 77 !! and time domain of the ocean model. 78 78 !! … … 89 89 INTEGER :: iconf = 0 ! local integers 90 90 REAL(wp):: zrdt 91 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" 91 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" 92 92 INTEGER , DIMENSION(jpi,jpj) :: ik_top , ik_bot ! top and bottom ocean level 93 93 REAL(wp), DIMENSION(jpi,jpj) :: z1_hu_0, z1_hv_0 … … 126 126 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 127 127 ENDIF 128 128 129 129 ! 130 130 ! !== Reference coordinate system ==! … … 240 240 WRITE(numout,*) 'dom_init : ==>>> END of domain initialization' 241 241 WRITE(numout,*) '~~~~~~~~' 242 WRITE(numout,*) 242 WRITE(numout,*) 243 243 ENDIF 244 244 ! … … 252 252 !! ** Purpose : initialization of global domain <--> local domain indices 253 253 !! 254 !! ** Method : 254 !! ** Method : 255 255 !! 256 256 !! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices … … 271 271 ! 272 272 mig0(:) = mig(:) - nn_hls 273 mjg0(:) = mjg(:) - nn_hls 274 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 273 mjg0(:) = mjg(:) - nn_hls 274 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 275 275 ! we must define mig0 and mjg0 as bellow. 276 276 ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: … … 279 279 ! 280 280 ! ! global domain, including halos, indices ==> local domain indices 281 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 282 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 281 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 282 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 283 283 DO ji = 1, jpiglo 284 284 mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) ) … … 387 387 !!---------------------------------------------------------------------- 388 388 !! *** ROUTINE dom_nam *** 389 !! 389 !! 390 390 !! ** Purpose : read domaine namelists and print the variables. 391 391 !! … … 549 549 ! 550 550 IF( .NOT.l_SAS .AND. iom_varid( numror, 'sshb', ldstop = .FALSE. ) <= 0 ) THEN !- Check absence of one of the Kbb field (here sshb) 551 ! ! (any Kbb field is missing ==> all Kbb fields are missing) 551 ! ! (any Kbb field is missing ==> all Kbb fields are missing) 552 552 IF( .NOT.l_1st_euler ) THEN 553 553 CALL ctl_warn('dom_nam : ssh at Kbb not found in restart files ', & … … 558 558 ENDIF 559 559 ELSEIF( .NOT.l_1st_euler ) THEN !* Initialization case 560 IF(lwp) WRITE(numout,*) 560 IF(lwp) WRITE(numout,*) 561 561 IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)' 562 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : l_1st_euler is forced to .true. ' 562 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : l_1st_euler is forced to .true. ' 563 563 l_1st_euler = .TRUE. 564 564 ENDIF … … 586 586 IF(lwp) WRITE(numout,*) 587 587 SELECT CASE ( nleapy ) !== Choose calendar for IOIPSL ==! 588 CASE ( 1 ) 588 CASE ( 1 ) 589 589 CALL ioconf_calendar('gregorian') 590 590 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year' … … 699 699 !!---------------------------------------------------------------------- 700 700 !! *** ROUTINE domain_cfg *** 701 !! 701 !! 702 702 !! ** Purpose : read the domain size in domain configuration file 703 703 !! … … 706 706 CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name 707 707 INTEGER , INTENT(out) :: kk_cfg ! configuration resolution 708 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 709 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. 708 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 709 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. 710 710 ! 711 711 INTEGER :: inum ! local integer … … 739 739 cd_cfg = 'UNKNOWN' 740 740 kk_cfg = -9999999 741 !- or they may be present as global attributes 742 !- (netcdf only) 741 !- or they may be present as global attributes 742 !- (netcdf only) 743 743 CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found 744 744 CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found … … 762 762 WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio 763 763 ENDIF 764 ! 764 ! 765 765 END SUBROUTINE domain_cfg 766 767 766 767 768 768 SUBROUTINE cfg_write 769 769 !!---------------------------------------------------------------------- 770 770 !! *** ROUTINE cfg_write *** 771 !! 772 !! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which 773 !! contains all the ocean domain informations required to 771 !! 772 !! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which 773 !! contains all the ocean domain informations required to 774 774 !! define an ocean configuration. 775 775 !! … … 777 777 !! ocean configuration. 778 778 !! 779 !! ** output file : domcfg_out.nc : domain size, characteristics, horizontal 779 !! ** output file : domcfg_out.nc : domain size, characteristics, horizontal 780 780 !! mesh, Coriolis parameter, and vertical scale factors 781 781 !! NB: also contain ORCA family information … … 794 794 ! ! create 'domcfg_out.nc' file ! 795 795 ! ! ============================= ! 796 ! 796 ! 797 797 clnam = cn_domcfg_out ! filename (configuration information) 798 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 798 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 799 799 ! 800 800 ! !== ORCA family specificities ==! 801 801 IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 802 802 CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 ) 803 CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 803 CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 804 804 ENDIF 805 805 ! … … 823 823 CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 ) 824 824 CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 ) 825 ! 825 ! 826 826 CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 ) ! longitude 827 827 CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 ) 828 828 CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 ) 829 829 CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 ) 830 ! 830 ! 831 831 CALL iom_rstput( 0, 0, inum, 'e1t' , e1t , ktype = jp_r8 ) ! i-scale factors (e1.) 832 832 CALL iom_rstput( 0, 0, inum, 'e1u' , e1u , ktype = jp_r8 ) … … 843 843 ! 844 844 ! !== vertical mesh ==! 845 ! 845 ! 846 846 CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d , ktype = jp_r8 ) ! reference 1D-coordinate 847 847 CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d , ktype = jp_r8 ) … … 854 854 CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 , ktype = jp_r8 ) 855 855 CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 , ktype = jp_r8 ) 856 ! 856 ! 857 857 ! !== wet top and bottom level ==! (caution: multiplied by ssmask) 858 858 ! … … 874 874 ! 875 875 ! ! ============================ 876 ! ! close the files 876 ! ! close the files 877 877 ! ! ============================ 878 878 CALL iom_close( inum )
Note: See TracChangeset
for help on using the changeset viewer.