- Timestamp:
- 2016-11-06T17:31:33+01:00 (8 years ago)
- Location:
- branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 1 added
- 17 edited
-
C1D/domc1d.F90 (modified) (3 diffs)
-
DOM/depth_e3.F90 (added)
-
DOM/domain.F90 (modified) (11 diffs)
-
DOM/domhgr.F90 (modified) (6 diffs)
-
DOM/dommsk.F90 (modified) (2 diffs)
-
DOM/domvvl.F90 (modified) (1 diff)
-
DOM/domzgr.F90 (modified) (10 diffs)
-
DOM/dtatsd.F90 (modified) (2 diffs)
-
LBC/mppini_2.h90 (modified) (3 diffs)
-
LDF/ldftra.F90 (modified) (1 diff)
-
SBC/sbcmod.F90 (modified) (1 diff)
-
TRA/traadv_fct.F90 (modified) (4 diffs)
-
TRA/trabbl.F90 (modified) (3 diffs)
-
USR/usrdef_closea.F90 (modified) (5 diffs)
-
USR/usrdef_nam.F90 (modified) (3 diffs)
-
USR/usrdef_zgr.F90 (modified) (1 diff)
-
nemogcm.F90 (modified) (20 diffs)
-
par_oce.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
r6596 r7200 85 85 ! mesh, only glamt and gphit ! 86 86 ! ============================= ! 87 87 ! 88 88 SELECT CASE( jphgr_msh ) ! type of horizontal mesh 89 89 ! 90 90 CASE ( 0 ) ! curvilinear coordinate on the sphere read in coordinate.nc file 91 91 ! 92 92 CALL iom_open( 'coordinates', inum ) 93 93 CALL iom_get( inum, jpdom_unknown, 'glamt', glamdta ) ! mig, mjg undefined at this point 94 94 CALL iom_get( inum, jpdom_unknown, 'gphit', gphidta ) ! so use jpdom_unknown not jpdom_data 95 95 CALL iom_close ( inum ) 96 96 ! 97 97 CASE ( 1 ) ! geographical mesh on the sphere with regular grid-spacing 98 98 ! 99 99 DO jj = 1, jpjdta 100 100 DO ji = 1, jpidta 101 101 zti = FLOAT( ji - 1 + nimpp - 1 ) 102 102 ztj = FLOAT( jj - 1 + njmpp - 1 ) 103 103 ! 104 104 glamdta(ji,jj) = ppglam0 + ppe1_deg * zti 105 105 gphidta(ji,jj) = ppgphi0 + ppe2_deg * ztj 106 106 END DO 107 107 END DO 108 108 ! 109 109 CASE ( 2:3 ) ! f- or beta-plane with regular grid-spacing 110 110 ! 111 111 glam0 = 0.e0 112 112 gphi0 = - ppe2_m * 1.e-3 113 113 ! 114 114 DO jj = 1, jpjdta 115 115 DO ji = 1, jpidta … … 118 118 END DO 119 119 END DO 120 120 ! 121 121 CASE ( 4 ) ! geographical mesh on the sphere, isotropic MERCATOR type 122 122 ! 123 123 IF( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' ) 124 124 ! 125 125 zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2. 126 126 ijeq = ABS( 180. / rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg ) 127 127 IF( ppgphi0 > 0 ) ijeq = -ijeq 128 128 ! 129 129 DO jj = 1, jpjdta 130 130 DO ji = 1, jpidta 131 131 zti = FLOAT( ji - 1 + nimpp - 1 ) 132 132 ztj = FLOAT( jj - ijeq + njmpp - 1 ) 133 133 ! 134 134 glamdta(ji,jj) = ppglam0 + ppe1_deg * zti 135 135 gphidta(ji,jj) = 1. / rad * ASIN ( TANH( ppe1_deg * rad * ztj ) ) 136 136 END DO 137 137 END DO 138 138 ! 139 139 CASE ( 5 ) ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration) 140 140 ! 141 141 zlam1 = -85 142 142 zphi1 = 29 143 ze1 = 106000. / FLOAT(jp_cfg)144 143 ze1 = 106000. / REAL( nn_cfg , wp ) 144 ! 145 145 zsin_alpha = - SQRT( 2. ) / 2. 146 146 zcos_alpha = SQRT( 2. ) / 2. 147 147 ze1deg = ze1 / (ra * rad) 148 148 ! 149 149 glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjdta-2 ) ! Force global 150 150 gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjdta-2 ) 151 151 ! 152 152 DO jj = 1, jpjdta 153 153 DO ji = 1, jpidta … … 159 159 END DO 160 160 END DO 161 161 ! 162 162 CASE DEFAULT 163 163 ! 164 164 WRITE(ctmp1,*) ' bad flag value for jphgr_msh = ', jphgr_msh 165 165 CALL ctl_stop( ctmp1 ) 166 166 ! 167 167 END SELECT 168 168 -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r7188 r7200 22 22 !! dom_nam : read and contral domain namelists 23 23 !! dom_ctl : control print for the ocean domain 24 !! cfg_write : create the "domain_cfg.nc" file containing all required configuration information 24 !! domain_cfg : read the global domain size in domain configuration file 25 !! cfg_write : create the domain configuration file 25 26 !!---------------------------------------------------------------------- 26 27 USE oce ! ocean variables … … 48 49 PRIVATE 49 50 50 PUBLIC dom_init ! called by opa.F90 51 PUBLIC dom_init ! called by nemogcm.F90 52 PUBLIC domain_cfg ! called by nemogcm.F90 51 53 52 54 !!------------------------------------------------------------------------- … … 110 112 END SELECT 111 113 WRITE(numout,*) ' Ocean model configuration used:' 112 WRITE(numout,*) ' c p_cfg = ', cp_cfg113 WRITE(numout,*) ' jp_cfg = ', jp_cfg114 WRITE(numout,*) ' cn_cfg = ', cn_cfg 115 WRITE(numout,*) ' nn_cfg = ', nn_cfg 114 116 ENDIF 115 117 ! … … 123 125 CALL dom_glo ! global domain versus local domain 124 126 CALL dom_nam ! read namelist ( namrun, namdom ) 125 CALL dom_clo( c p_cfg, jp_cfg ) ! Closed seas and lake127 CALL dom_clo( cn_cfg, nn_cfg ) ! Closed seas and lake 126 128 CALL dom_hgr ! Horizontal mesh 127 129 CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry … … 287 289 INTEGER :: ios ! Local integer output status for namelist read 288 290 !!---------------------------------------------------------------------- 289 291 ! 290 292 REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run 291 293 READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 292 294 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 293 295 ! 294 296 REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run 295 297 READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) … … 380 382 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 381 383 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 382 383 384 ! 384 385 REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) … … 414 415 READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 415 416 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 416 417 ! 417 418 REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF 418 419 READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) … … 492 493 493 494 495 SUBROUTINE domain_cfg( ldtxt, ldnam, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 496 !!---------------------------------------------------------------------- 497 !! *** ROUTINE dom_nam *** 498 !! 499 !! ** Purpose : read the domain size in domain configuration file 500 !! 501 !! ** Method : 502 !! 503 !!---------------------------------------------------------------------- 504 CHARACTER(len=*), DIMENSION(:), INTENT(out) :: ldtxt, ldnam ! stored print information 505 CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name 506 INTEGER , INTENT(out) :: kk_cfg ! configuration resolution 507 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 508 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. 509 ! 510 INTEGER :: inum, ii ! local integer 511 REAL(wp) :: zorca_res ! local scalars 512 REAL(wp) :: ziglo, zjglo, zkglo, zperio ! - - 513 !!---------------------------------------------------------------------- 514 ! 515 ii = 1 516 WRITE(ldtxt(ii),*) ' ' ; ii = ii+1 517 WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in', TRIM( cn_domcfg ), ' file' ; ii = ii+1 518 WRITE(ldtxt(ii),*) '~~~~~~~~~~ ' ; ii = ii+1 519 ! 520 CALL iom_open( cn_domcfg, inum ) 521 ! 522 ! !- ORCA family specificity 523 IF( iom_varid( inum, 'ORCA' , ldstop = .FALSE. ) > 0 .AND. & 524 & iom_varid( inum, 'ORCA_resolution', ldstop = .FALSE. ) > 0 ) THEN 525 ! 526 cd_cfg = 'ORCA' 527 CALL iom_get( inum, 'ORCA_resolution', zorca_res ) ; kk_cfg = INT( zorca_res ) 528 ! 529 WRITE(ldtxt(ii),*) ' ' ; ii = ii+1 530 WRITE(ldtxt(ii),*) ' ==>>> ORCA configuration ' ; ii = ii+1 531 WRITE(ldtxt(ii),*) ' ' ; ii = ii+1 532 ! 533 ELSE !- cd_cfg & k_cfg are not used 534 cd_cfg = 'UNKNOWN' 535 kk_cfg = -9999999 536 ENDIF 537 ! 538 CALL iom_get( inum, 'jpiglo', ziglo ) ; jpiglo = INT( ziglo ) 539 CALL iom_get( inum, 'jpjglo', zjglo ) ; jpjglo = INT( zjglo ) 540 CALL iom_get( inum, 'jpkglo', zkglo ) ; jpkglo = INT( zkglo ) 541 CALL iom_get( inum, 'jperio', zperio ) ; jperio = INT( zperio ) 542 CALL iom_close( inum ) 543 ! 544 WRITE(ldtxt(ii),*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg ; ii = ii+1 545 WRITE(ldtxt(ii),*) ' jpiglo = ', jpiglo ; ii = ii+1 546 WRITE(ldtxt(ii),*) ' jpjglo = ', jpjglo , ' jpkglo = ', jpkglo ; ii = ii +1 547 WRITE(ldtxt(ii),*) ' jpkglo = ', jpkglo ; ii = ii +1 548 WRITE(ldtxt(ii),*) ' type of global domain lateral boundary jperio = ', jperio ; ii = ii +1 549 ! 550 END SUBROUTINE domain_cfg 551 552 494 553 SUBROUTINE cfg_write 495 554 !!---------------------------------------------------------------------- 496 555 !! *** ROUTINE cfg_write *** 497 556 !! 498 !! ** Purpose : Create the " domain_cfg" file, a NetCDF file which557 !! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which 499 558 !! contains all the ocean domain informations required to 500 559 !! define an ocean configuration. … … 503 562 !! ocean configuration. 504 563 !! 505 !! ** output file : domain_cfg.nc : domain size, characteristics, horizontal mesh, 506 !! Coriolis parameter, depth and vertical scale factors 564 !! ** output file : domcfg_out.nc : domain size, characteristics, horizontal 565 !! mesh, Coriolis parameter, and vertical scale factors 566 !! NB: also contain ORCA family information 507 567 !!---------------------------------------------------------------------- 508 568 INTEGER :: ji, jj, jk ! dummy loop indices 509 569 INTEGER :: izco, izps, isco, icav 510 INTEGER :: inum ! temprary units for 'domain_cfg.nc' file570 INTEGER :: inum ! local units 511 571 CHARACTER(len=21) :: clnam ! filename (mesh and mask informations) 512 572 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! workspace … … 514 574 ! 515 575 IF(lwp) WRITE(numout,*) 516 IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information'576 IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)' 517 577 IF(lwp) WRITE(numout,*) '~~~~~~~~~' 518 578 ! 519 579 ! ! ============================= ! 520 ! ! create 'dom ain_cfg.nc' file !580 ! ! create 'domcfg_out.nc' file ! 521 581 ! ! ============================= ! 522 582 ! 523 clnam = 'dom ain_cfg' ! filename (configuration information)583 clnam = 'domcfg_out' ! filename (configuration information) 524 584 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib ) 525 585 586 ! 587 ! !== ORCA family specificities ==! 588 IF( cn_cfg == "ORCA" ) THEN 589 CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 ) 590 CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 591 ENDIF 592 ! 526 593 ! !== global domain size ==! 527 594 ! … … 574 641 ! !== vertical mesh ==! 575 642 ! 576 CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d 577 CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d 578 ! 579 CALL iom_rstput( 0, 0, inum, 'e3t_0' , e3t_0 580 CALL iom_rstput( 0, 0, inum, 'e3u_0' , e3u_0 581 CALL iom_rstput( 0, 0, inum, 'e3v_0' , e3v_0 582 CALL iom_rstput( 0, 0, inum, 'e3f_0' , e3f_0 583 CALL iom_rstput( 0, 0, inum, 'e3w_0' , e3w_0 584 CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 585 CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 643 CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d , ktype = jp_r8 ) ! reference 1D-coordinate 644 CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d , ktype = jp_r8 ) 645 ! 646 CALL iom_rstput( 0, 0, inum, 'e3t_0' , e3t_0 , ktype = jp_r8 ) ! vertical scale factors 647 CALL iom_rstput( 0, 0, inum, 'e3u_0' , e3u_0 , ktype = jp_r8 ) 648 CALL iom_rstput( 0, 0, inum, 'e3v_0' , e3v_0 , ktype = jp_r8 ) 649 CALL iom_rstput( 0, 0, inum, 'e3f_0' , e3f_0 , ktype = jp_r8 ) 650 CALL iom_rstput( 0, 0, inum, 'e3w_0' , e3w_0 , ktype = jp_r8 ) 651 CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 , ktype = jp_r8 ) 652 CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 , ktype = jp_r8 ) 586 653 ! 587 654 ! !== wet top and bottom level ==! (caution: multiplied by ssmask) -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r6894 r7200 21 21 !!---------------------------------------------------------------------- 22 22 !! dom_hgr : initialize the horizontal mesh 23 !! hgr_read : read "coordinate" NetCDFfile23 !! hgr_read : read horizontal information in the domain configuration file 24 24 !!---------------------------------------------------------------------- 25 25 USE dom_oce ! ocean space and time domain … … 91 91 IF( ln_read_cfg ) THEN !== read in mesh_mask.nc file ==! 92 92 IF(lwp) WRITE(numout,*) 93 IF(lwp) WRITE(numout,*) ' read horizontal mesh in "domain_cfg"file'93 IF(lwp) WRITE(numout,*) ' read horizontal mesh in ', TRIM( cn_domcfg ), ' file' 94 94 ! 95 95 CALL hgr_read ( glamt , glamu , glamv , glamf , & ! geographic position (required) … … 121 121 ELSE 122 122 IF( ln_read_cfg ) THEN 123 IF(lwp) WRITE(numout,*) ' Coriolis parameter have been read in "domain_cfg"file'123 IF(lwp) WRITE(numout,*) ' Coriolis parameter have been read in ', TRIM( cn_domcfg ), ' file' 124 124 ELSE 125 125 IF(lwp) WRITE(numout,*) ' Coriolis parameter have been set in usr_def_hgr routine' … … 186 186 ENDIF 187 187 ! 188 CALL iom_open( 'domain_cfg', inum )188 CALL iom_open( cn_domcfg, inum ) 189 189 ! 190 190 CALL iom_get( inum, jpdom_data, 'glamt', plamt, lrowattr=ln_use_jattr ) … … 210 210 IF( iom_varid( inum, 'ff_f', ldstop = .FALSE. ) > 0 .AND. & 211 211 & iom_varid( inum, 'ff_t', ldstop = .FALSE. ) > 0 ) THEN 212 IF(lwp) WRITE(numout,*) ' Coriolis factor at f- and t-points read in domain_cfgfile'212 IF(lwp) WRITE(numout,*) ' Coriolis factor at f- and t-points read in ', TRIM( cn_domcfg ), ' file' 213 213 CALL iom_get( inum, jpdom_data, 'ff_f' , pff_f , lrowattr=ln_use_jattr ) 214 214 CALL iom_get( inum, jpdom_data, 'ff_t' , pff_t , lrowattr=ln_use_jattr ) … … 219 219 ! 220 220 IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN 221 IF(lwp) WRITE(numout,*) ' e1e2u & e1e2v read in domain_cfgfile'221 IF(lwp) WRITE(numout,*) ' e1e2u & e1e2v read in ', TRIM( cn_domcfg ), ' file' 222 222 CALL iom_get( inum, jpdom_data, 'e1e2u' , pe1e2u , lrowattr=ln_use_jattr ) 223 223 CALL iom_get( inum, jpdom_data, 'e1e2v' , pe1e2v , lrowattr=ln_use_jattr ) -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r7111 r7200 140 140 END DO 141 141 END DO 142 !SF add here lbc_lnk: bug not still understood : cause now domain_cfg is read ! 142 !SF add here lbc_lnk: bug not still understood : cause now domain configuration is read ! 143 !!gm I don't understand why... 143 144 CALL lbc_lnk( tmask , 'T', 1._wp ) ! Lateral boundary conditions 144 145 … … 263 264 ! -------------------------------- 264 265 ! 265 CALL usr_def_fmask( c p_cfg, jp_cfg, fmask )266 CALL usr_def_fmask( cn_cfg, nn_cfg, fmask ) 266 267 ! 267 268 ! -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r6667 r7200 232 232 END DO 233 233 END DO 234 IF( c p_cfg == "orca" .AND. jp_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2234 IF( cn_cfg == "orca" .AND. nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 235 235 ii0 = 103 ; ii1 = 111 236 236 ij0 = 128 ; ij1 = 135 ; -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r7189 r7200 23 23 !!---------------------------------------------------------------------- 24 24 !! dom_zgr : read or set the ocean vertical coordinate system 25 !! zgr_read : read the vertical domain coordinate and mask in domain_cfgfile25 !! zgr_read : read the vertical information in the domain configuration file 26 26 !! zgr_top_bot : ocean top and bottom level for t-, u, and v-points with 1 as minimum value 27 27 !!--------------------------------------------------------------------- … … 89 89 IF( ln_read_cfg ) THEN !== read in mesh_mask.nc file ==! 90 90 IF(lwp) WRITE(numout,*) 91 IF(lwp) WRITE(numout,*) ' Read vertical mesh in "domain_cfg"file'91 IF(lwp) WRITE(numout,*) ' Read vertical mesh in ', TRIM( cn_domcfg ), ' file' 92 92 ! 93 93 CALL zgr_read ( ln_zco , ln_zps , ln_sco, ln_isfcav, & … … 120 120 IF(lwp) THEN ! Control print 121 121 WRITE(numout,*) 122 WRITE(numout,*) ' Type of vertical coordinate (read in domain_cfg.nc or set through user defined routines) :'122 WRITE(numout,*) ' Type of vertical coordinate (read in ', TRIM( cn_domcfg ), ' file or set in userdef_nam) :' 123 123 WRITE(numout,*) ' z-coordinate - full steps ln_zco = ', ln_zco 124 124 WRITE(numout,*) ' z-coordinate - partial steps ln_zps = ', ln_zps … … 178 178 !! *** ROUTINE zgr_read *** 179 179 !! 180 !! ** Purpose : Read the vertical information in a domain_cfg.ncfile180 !! ** Purpose : Read the vertical information in the domain configuration file 181 181 !! 182 182 !!---------------------------------------------------------------------- … … 198 198 IF(lwp) THEN 199 199 WRITE(numout,*) 200 WRITE(numout,*) ' zgr_read : read the vertical coordinates in "domain_cfg.nc"file'201 WRITE(numout,*) ' ~~~~~~~~ jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo202 ENDIF 203 ! 204 CALL iom_open( 'domain_cfg', inum )205 ! 206 ! !type of vertical coordinate200 WRITE(numout,*) ' zgr_read : read the vertical coordinates in ', TRIM( cn_domcfg ), ' file' 201 WRITE(numout,*) ' ~~~~~~~~' 202 ENDIF 203 ! 204 CALL iom_open( cn_domcfg, inum ) 205 ! 206 ! !* type of vertical coordinate 207 207 CALL iom_get( inum, 'ln_zco' , z_zco ) 208 208 CALL iom_get( inum, 'ln_zps' , z_zps ) … … 212 212 IF( z_sco == 0._wp ) THEN ; ld_sco = .false. ; ELSE ; ld_sco = .true. ; ENDIF 213 213 ! 214 ! !ocean cavities under iceshelves214 ! !* ocean cavities under iceshelves 215 215 CALL iom_get( inum, 'ln_isfcav', z_cav ) 216 216 IF( z_cav == 0._wp ) THEN ; ld_isfcav = .false. ; ELSE ; ld_isfcav = .true. ; ENDIF 217 217 ! 218 ! ! 1D vertical scale factors (reference coordinate)219 CALL iom_get( inum, jpdom_unknown, 'e3t_1d' , pe3t_1d ) 218 ! !* vertical scale factors 219 CALL iom_get( inum, jpdom_unknown, 'e3t_1d' , pe3t_1d ) ! 1D reference coordinate 220 220 CALL iom_get( inum, jpdom_unknown, 'e3w_1d' , pe3w_1d ) 221 221 ! 222 ! ! 3D vertical scale factors 223 CALL iom_get( inum, jpdom_data, 'e3t_0' , pe3t , lrowattr=ln_use_jattr ) 222 CALL iom_get( inum, jpdom_data, 'e3t_0' , pe3t , lrowattr=ln_use_jattr ) ! 3D coordinate 224 223 CALL iom_get( inum, jpdom_data, 'e3u_0' , pe3u , lrowattr=ln_use_jattr ) 225 224 CALL iom_get( inum, jpdom_data, 'e3v_0' , pe3v , lrowattr=ln_use_jattr ) … … 229 228 CALL iom_get( inum, jpdom_data, 'e3vw_0' , pe3vw , lrowattr=ln_use_jattr ) 230 229 ! 231 ! ! 1D & 3D depths 232 ! 233 ! ! old depth definition (obsolescent feature) 230 ! !* depths 231 ! !- old depth definition (obsolescent feature) 234 232 IF( iom_varid( inum, 'gdept_1d', ldstop = .FALSE. ) > 0 .AND. & 235 233 & iom_varid( inum, 'gdepw_1d', ldstop = .FALSE. ) > 0 .AND. & … … 237 235 & iom_varid( inum, 'gdepw_0' , ldstop = .FALSE. ) > 0 ) THEN 238 236 CALL ctl_warn( 'zgr_read : old definition of depths and scale factors used ', & 239 & 'depths at t- and w-points read in domain_cfgfile')237 & ' depths at t- and w-points read in the domain configuration file') 240 238 CALL iom_get( inum, jpdom_unknown, 'gdept_1d', pdept_1d ) 241 239 CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', pdepw_1d ) … … 243 241 CALL iom_get( inum, jpdom_data , 'gdepw_0' , pdepw , lrowattr=ln_use_jattr ) 244 242 ! 245 ELSE ! depths computed from e3. scale factors 246 ! 243 ELSE !- depths computed from e3. scale factors 247 244 CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d ) ! 1D reference depth 245 CALL e3_to_depth( pe3t , pe3w , pdept , pdepw ) ! 3D depths 248 246 IF(lwp) THEN 249 247 WRITE(numout,*) … … 252 250 WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk ) 253 251 ENDIF 254 ! 255 CALL e3_to_depth( pe3t , pe3w , pdept , pdepw ) ! 3D depths 256 ! 257 ENDIF 258 ! 259 ! ! ocean top and bottom level 260 CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d , lrowattr=ln_use_jattr ) ! nb of ocean T-points 252 ENDIF 253 ! 254 ! !* ocean top and bottom level 255 CALL iom_get( inum, jpdom_data, 'top_level' , z2d , lrowattr=ln_use_jattr ) ! 1st wet T-points (ISF) 256 k_top(:,:) = INT( z2d(:,:) ) 257 CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d , lrowattr=ln_use_jattr ) ! last wet T-points 261 258 k_bot(:,:) = INT( z2d(:,:) ) 262 CALL iom_get( inum, jpdom_data, 'top_level' , z2d , lrowattr=ln_use_jattr ) ! nb of ocean T-points (ISF)263 k_top(:,:) = INT( z2d(:,:) )264 259 ! 265 260 CALL iom_close( inum ) -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
r6580 r7200 155 155 ! 156 156 ! 157 !!gm This should be removed from the code ===>>>> T & S files has to be changed 158 ! 157 159 ! !== ORCA_R2 configuration and T & S damping ==! 158 IF( c p_cfg == "orca" .AND. jp_cfg == 2 .AND. ln_tsd_tradmp ) THEN ! some hand made alterations160 IF( cn_cfg == "orca" .AND. nn_cfg == 2 .AND. ln_tsd_tradmp ) THEN ! some hand made alterations 159 161 ! 160 162 ij0 = 101 ; ij1 = 109 ! Reduced T & S in the Alboran Sea … … 178 180 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 179 181 ENDIF 182 !!gm end 180 183 ! 181 184 ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:) ! NO mask -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
r6977 r7200 6 6 !! FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED 7 7 !! FOR DEFINING BETTER CUTTING OUT. 8 !! This routine requires the presence of the "domain_cfg.nc"file.8 !! This routine requires the presence of the domain configuration file. 9 9 !! In this version, the land processors are avoided and the adress 10 10 !! processor (nproc, narea,noea, ...) are calculated again. … … 37 37 !! ! 1998-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 38 38 !! NEMO 1.0 ! 2004-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 39 !! 4.0 ! 2016-06 (G. Madec) use domain _cfgfile instead of bathymetry file39 !! 4.0 ! 2016-06 (G. Madec) use domain configuration file instead of bathymetry file 40 40 !!---------------------------------------------------------------------- 41 41 USE in_out_manager ! I/O Manager … … 83 83 ! 0. initialisation 84 84 ! ----------------- 85 CALL iom_open( 'domain_cfg', inum )85 CALL iom_open( cn_domcfg, inum ) 86 86 ! 87 87 ! ! ocean top and bottom level -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r6596 r7200 558 558 END DO 559 559 560 !!gm IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2561 !!gm DO jj = 2, jpjm1562 !!gm DO ji = fs_2, fs_jpim1 ! vector opt.563 !!gm ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m)564 !!gm IF( mbkt(ji,jj) <= 20 ) zaeiw(ji,jj) = MIN( zaeiw(ji,jj), 1000. )565 !!gm END DO566 !!gm END DO567 !!gm ENDIF568 569 560 ! !== Bound on eiv coeff. ==! 570 561 z1_f20 = 1._wp / ( 2._wp * omega * sin( rad * 20._wp ) ) -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r6900 r7200 378 378 ! (update freshwater fluxes) 379 379 ! Should not be ran if ln_diurnal_only 380 IF( .NOT. (ln_diurnal_only) .AND. (nn_closea == 1) ) CALL sbc_clo( kt)380 IF( .NOT.ln_diurnal_only .AND. nn_closea == 1 ) CALL sbc_clo( kt, cn_cfg, nn_cfg ) 381 381 382 382 !RBbug do not understand why see ticket 667 -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r6900 r7200 38 38 REAL(wp) :: r1_6 = 1._wp / 6._wp ! =1/6 39 39 40 ! ! tridiag solver associated indices: 41 INTEGER, PARAMETER :: np_NH = 0 ! Neumann homogeneous boundary condition 42 INTEGER, PARAMETER :: np_CEN2 = 1 ! 2nd order centered boundary condition 43 40 44 !! * Substitutions 41 45 # include "vectopt_loop_substitute.h90" … … 706 710 707 711 708 SUBROUTINE interp_4th_cpt ( pt_in, pt_out )709 !!---------------------------------------------------------------------- 710 !! *** ROUTINE interp_4th_cpt ***712 SUBROUTINE interp_4th_cpt_org( pt_in, pt_out ) 713 !!---------------------------------------------------------------------- 714 !! *** ROUTINE interp_4th_cpt_org *** 711 715 !! 712 716 !! ** Purpose : Compute the interpolation of tracer at w-point … … 739 743 END DO 740 744 ! 741 jk =2! Switch to second order centered at top742 DO jj =1,jpj743 DO ji =1,jpi745 jk = 2 ! Switch to second order centered at top 746 DO jj = 1, jpj 747 DO ji = 1, jpi 744 748 zwd (ji,jj,jk) = 1._wp 745 749 zwi (ji,jj,jk) = 0._wp … … 789 793 END DO 790 794 ! 795 END SUBROUTINE interp_4th_cpt_org 796 797 798 SUBROUTINE interp_4th_cpt( pt_in, pt_out ) 799 !!---------------------------------------------------------------------- 800 !! *** ROUTINE interp_4th_cpt *** 801 !! 802 !! ** Purpose : Compute the interpolation of tracer at w-point 803 !! 804 !! ** Method : 4th order compact interpolation 805 !!---------------------------------------------------------------------- 806 REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt_in ! field at t-point 807 REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT( out) :: pt_out ! field interpolated at w-point 808 ! 809 INTEGER :: ji, jj, jk ! dummy loop integers 810 INTEGER :: ikt, ikb ! local integers 811 REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt 812 !!---------------------------------------------------------------------- 813 ! 814 ! !== build the three diagonal matrix & the RHS ==! 815 ! 816 DO jk = 3, jpkm1 ! interior (from jk=3 to jpk-1) 817 DO jj = 2, jpjm1 818 DO ji = fs_2, fs_jpim1 819 zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp ! diagonal 820 zwi (ji,jj,jk) = wmask(ji,jj,jk) ! lower diagonal 821 zws (ji,jj,jk) = wmask(ji,jj,jk) ! upper diagonal 822 zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk) & ! RHS 823 & * ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) ) 824 END DO 825 END DO 826 END DO 827 ! 828 !!gm 829 ! SELECT CASE( kbc ) !* boundary condition 830 ! CASE( np_NH ) ! Neumann homogeneous at top & bottom 831 ! CASE( np_CEN2 ) ! 2nd order centered at top & bottom 832 ! END SELECT 833 !!gm 834 ! 835 DO jj = 2, jpjm1 ! 2nd order centered at top & bottom 836 DO ji = fs_2, fs_jpim1 837 ikt = mikt(ji,jj) + 1 ! w-point below the 1st wet point 838 ikb = mbkt(ji,jj) ! - above the last wet point 839 ! 840 zwd (ji,jj,ikt) = 1._wp ! top 841 zwi (ji,jj,ikt) = 0._wp 842 zws (ji,jj,ikt) = 0._wp 843 zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) ) 844 ! 845 zwd (ji,jj,ikb) = 1._wp ! bottom 846 zwi (ji,jj,ikb) = 0._wp 847 zws (ji,jj,ikb) = 0._wp 848 zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) ) 849 END DO 850 END DO 851 ! 852 ! !== tridiagonal solver ==! 853 ! 854 DO jj = 2, jpjm1 !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 855 DO ji = fs_2, fs_jpim1 856 zwt(ji,jj,2) = zwd(ji,jj,2) 857 END DO 858 END DO 859 DO jk = 3, jpkm1 860 DO jj = 2, jpjm1 861 DO ji = fs_2, fs_jpim1 862 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1) 863 END DO 864 END DO 865 END DO 866 ! 867 DO jj = 2, jpjm1 !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 868 DO ji = fs_2, fs_jpim1 869 pt_out(ji,jj,2) = zwrm(ji,jj,2) 870 END DO 871 END DO 872 DO jk = 3, jpkm1 873 DO jj = 2, jpjm1 874 DO ji = fs_2, fs_jpim1 875 pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 876 END DO 877 END DO 878 END DO 879 880 DO jj = 2, jpjm1 !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 881 DO ji = fs_2, fs_jpim1 882 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 883 END DO 884 END DO 885 DO jk = jpk-2, 2, -1 886 DO jj = 2, jpjm1 887 DO ji = fs_2, fs_jpim1 888 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 889 END DO 890 END DO 891 END DO 892 ! 791 893 END SUBROUTINE interp_4th_cpt 792 894 895 896 SUBROUTINE tridia_solver( pD, pU, pL, pRHS, pt_out , klev ) 897 !!---------------------------------------------------------------------- 898 !! *** ROUTINE tridia_solver *** 899 !! 900 !! ** Purpose : solve a symmetric 3diagonal system 901 !! 902 !! ** Method : solve M.t_out = RHS(t) where M is a tri diagonal matrix ( jpk*jpk ) 903 !! 904 !! ( D_1 U_1 0 0 0 )( t_1 ) ( RHS_1 ) 905 !! ( L_2 D_2 U_2 0 0 )( t_2 ) ( RHS_2 ) 906 !! ( 0 L_3 D_3 U_3 0 )( t_3 ) = ( RHS_3 ) 907 !! ( ... )( ... ) ( ... ) 908 !! ( 0 0 0 L_k D_k )( t_k ) ( RHS_k ) 909 !! 910 !! M is decomposed in the product of an upper and lower triangular matrix. 911 !! The tri-diagonals matrix is given as input 3D arrays: pD, pU, pL 912 !! (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal). 913 !! The solution is pta. 914 !! The 3d array zwt is used as a work space array. 915 !!---------------------------------------------------------------------- 916 REAL(wp),DIMENSION(:,:,:), INTENT(in ) :: pD, pU, PL ! 3-diagonal matrix 917 REAL(wp),DIMENSION(:,:,:), INTENT(in ) :: pRHS ! Right-Hand-Side 918 REAL(wp),DIMENSION(:,:,:), INTENT( out) :: pt_out !!gm field at level=F(klev) 919 INTEGER , INTENT(in ) :: klev ! =1 pt_out at w-level 920 ! ! =0 pt at t-level 921 INTEGER :: ji, jj, jk ! dummy loop integers 922 INTEGER :: kstart ! local indices 923 REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwt ! 3D work array 924 !!---------------------------------------------------------------------- 925 ! 926 kstart = 1 + klev 927 ! 928 DO jj = 2, jpjm1 !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 929 DO ji = fs_2, fs_jpim1 930 zwt(ji,jj,kstart) = pD(ji,jj,kstart) 931 END DO 932 END DO 933 DO jk = kstart+1, jpkm1 934 DO jj = 2, jpjm1 935 DO ji = fs_2, fs_jpim1 936 zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1) 937 END DO 938 END DO 939 END DO 940 ! 941 DO jj = 2, jpjm1 !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 942 DO ji = fs_2, fs_jpim1 943 pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart) 944 END DO 945 END DO 946 DO jk = kstart+1, jpkm1 947 DO jj = 2, jpjm1 948 DO ji = fs_2, fs_jpim1 949 pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 950 END DO 951 END DO 952 END DO 953 954 DO jj = 2, jpjm1 !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 955 DO ji = fs_2, fs_jpim1 956 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 957 END DO 958 END DO 959 DO jk = jpk-2, kstart, -1 960 DO jj = 2, jpjm1 961 DO ji = fs_2, fs_jpim1 962 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 963 END DO 964 END DO 965 END DO 966 ! 967 END SUBROUTINE tridia_solver 968 793 969 !!====================================================================== 794 970 END MODULE traadv_fct -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r6717 r7200 545 545 CALL wrk_dealloc( jpi, jpj, zmbk ) 546 546 547 547 ! !* sign of grad(H) at u- and v-points 548 548 mgrhu(jpi,:) = 0 ; mgrhu(:,jpj) = 0 ; mgrhv(jpi,:) = 0 ; mgrhv(:,jpj) = 0 549 549 DO jj = 1, jpjm1 … … 553 553 END DO 554 554 END DO 555 555 ! 556 556 DO jj = 1, jpjm1 !* bbl thickness at u- (v-) point 557 557 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0) … … 561 561 END DO 562 562 CALL lbc_lnk( e3u_bbl_0, 'U', 1. ) ; CALL lbc_lnk( e3v_bbl_0, 'V', 1. ) ! lateral boundary conditions 563 563 ! 564 564 ! !* masked diffusive flux coefficients 565 565 ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 566 566 ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 567 567 568 569 IF( cp_cfg == "orca" ) THEN !* ORCA configuration : regional enhancement of ah_bbl570 !571 SELECT CASE ( jp_cfg )572 CASE ( 2 ) ! ORCA_R2573 ij0 = 102 ; ij1 = 102 ! Gibraltar enhancement of BBL574 ii0 = 139 ; ii1 = 140575 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))576 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))577 !578 ij0 = 88 ; ij1 = 88 ! Red Sea enhancement of BBL579 ii0 = 161 ; ii1 = 162580 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))581 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))582 !583 END SELECT584 !585 ENDIF586 568 ! 587 569 IF( nn_timing == 1 ) CALL timing_stop( 'tra_bbl_init') -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_closea.F90
r6923 r7200 35 35 PRIVATE 36 36 37 PUBLIC dom_clo ! routinecalled by domain module38 PUBLIC sbc_clo ! routinecalled by step module39 PUBLIC clo_rnf ! routinecalled by sbcrnf module40 PUBLIC clo_bat ! routinecalled in domzgr module37 PUBLIC dom_clo ! called by domain module 38 PUBLIC sbc_clo ! called by step module 39 PUBLIC clo_rnf ! called by sbcrnf module 40 PUBLIC clo_bat ! called in domzgr module 41 41 42 42 INTEGER, PUBLIC, PARAMETER :: jpncs = 4 !: number of closed sea … … 75 75 !! =2 put at location runoff 76 76 !!---------------------------------------------------------------------- 77 CHARACTER(len= 1), INTENT(in ) :: cd_cfg ! configuration name77 CHARACTER(len=*), INTENT(in ) :: cd_cfg ! configuration name 78 78 INTEGER , INTENT(in ) :: kcfg ! configuration identifier 79 79 ! … … 177 177 178 178 179 SUBROUTINE sbc_clo( kt )179 SUBROUTINE sbc_clo( kt, cd_cfg, kcfg ) 180 180 !!--------------------------------------------------------------------- 181 181 !! *** ROUTINE sbc_clo *** … … 189 189 !! ** Action : emp updated surface freshwater fluxes and associated heat content at kt 190 190 !!---------------------------------------------------------------------- 191 INTEGER, INTENT(in) :: kt ! ocean model time step 191 INTEGER , INTENT(in ) :: kt ! ocean model time step 192 CHARACTER(len=*), INTENT(in ) :: cd_cfg ! configuration name 193 INTEGER , INTENT(in ) :: kcfg ! configuration identifier 192 194 ! 193 195 INTEGER :: ji, jj, jc, jn ! dummy loop indices … … 272 274 ENDIF 273 275 274 IF( c p_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! Black Sea case for ORCA_R2 configuration276 IF( cd_cfg == "orca" .AND. kcfg == 2 ) THEN ! Black Sea case for ORCA_R2 configuration 275 277 zze2 = ( zfwf(3) + zfwf(4) ) * 0.5_wp 276 278 zfwf(3) = zze2 -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_nam.F90
r6923 r7200 38 38 CONTAINS 39 39 40 SUBROUTINE usr_def_nam( ldtxt, ldnam, kpi, kpj, kpk, kperio )40 SUBROUTINE usr_def_nam( ldtxt, ldnam, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 41 41 !!---------------------------------------------------------------------- 42 42 !! *** ROUTINE dom_nam *** … … 51 51 !!---------------------------------------------------------------------- 52 52 CHARACTER(len=*), DIMENSION(:), INTENT(out) :: ldtxt, ldnam ! stored print information 53 CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name 54 INTEGER , INTENT(out) :: kk_cfg ! configuration resolution 53 55 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 54 56 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. … … 66 68 ! 67 69 WRITE( ldnam(:), namusr_def ) 70 ! 71 cd_cfg = 'GYRE' ! name & resolution (not used) 72 kk_cfg = nn_GYRE 68 73 ! 69 74 kpi = 30 * nn_GYRE + 2 ! Global Domain size -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90
r7188 r7200 112 112 !! e3t_1d(jpk) = 2 * ( dept_1d(jpk) - depw_1d(jpk) ) 113 113 !! The depth are then re-computed from the sum of e3. This ensures 114 !! that depths are identical when reading domain _cfg.nc file. Indeed,115 !! Only e3. are saved in this file, depth are compute by a call to116 !! t he e3_to_depth subroutine.114 !! that depths are identical when reading domain configuration file. 115 !! Indeed, only e3. are saved in this file, depth are compute by a call 116 !! to the e3_to_depth subroutine. 117 117 !! 118 118 !! Here the Madec & Imbard (1996) function is used. -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r7188 r7200 46 46 !!---------------------------------------------------------------------- 47 47 USE step_oce ! module used in the ocean time stepping module (step.F90) 48 USE mppini ! shared/distributed memory setting (mpp_init routine) 49 USE domain ! domain initialization (dom_init routine) 50 #if defined key_nemocice_decomp 51 USE ice_domain_size, only: nx_global, ny_global 52 #endif 48 USE phycst ! physical constant (par_cst routine) 49 USE domain ! domain initialization (dom_init & dom_cfg routines) 50 USE usrdef_nam ! user defined configuration 53 51 USE tideini ! tidal components initialization (tide_ini routine) 54 52 USE bdyini ! open boundary cond. setting (bdy_init routine) … … 60 58 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 61 59 USE zdfini ! vertical physics setting (zdf_init routine) 62 USE phycst ! physical constant (par_cst routine)63 60 USE trdini ! dyn/tra trends initialization (trd_init routine) 64 61 USE asminc ! assimilation increments … … 68 65 USE diaobs ! Observation diagnostics (dia_obs_init routine) 69 66 USE diacfl ! CFL diagnostics (dia_cfl_init routine) 70 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)71 67 USE step ! NEMO time-stepping (stp routine) 72 68 USE icbini ! handle bergs, initialisation … … 78 74 USE stopar ! Stochastic param.: ??? 79 75 USE stopts ! Stochastic param.: ??? 76 USE diurnal_bulk ! diurnal bulk SST 77 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 78 USE crsini ! initialise grid coarsening utility 79 USE diatmb ! Top,middle,bottom output 80 USE dia25h ! 25h mean output 81 USE sbc_oce , ONLY : lk_oasis 82 USE wet_dry ! Wetting and drying setting (wad_init routine) 80 83 #if defined key_top 81 84 USE trcini ! passive tracer initialisation 82 85 #endif 86 #if defined key_nemocice_decomp 87 USE ice_domain_size, only: nx_global, ny_global 88 #endif 89 ! 83 90 USE lib_mpp ! distributed memory computing 84 USE diurnal_bulk ! diurnal bulk SST 85 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 91 USE mppini ! shared/distributed memory setting (mpp_init routine) 92 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 93 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 86 94 #if defined key_iomput 87 95 USE xios ! xIOserver 88 96 #endif 89 USE crsini ! initialise grid coarsening utility90 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges91 USE sbc_oce, ONLY : lk_oasis92 USE diatmb ! Top,middle,bottom output93 USE dia25h ! 25h mean output94 USE wet_dry ! Wetting and drying setting (wad_init routine)95 USE usrdef_nam ! user defined configuration96 97 97 98 IMPLICIT NONE … … 125 126 !! Madec, 2008, internal report, IPSL. 126 127 !!---------------------------------------------------------------------- 127 INTEGER :: istp 128 INTEGER :: istp ! time step index 128 129 !!---------------------------------------------------------------------- 129 130 ! … … 196 197 ! !== finalize the run ==! 197 198 ! !------------------------! 198 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA199 ! 200 IF( nstop /= 0 .AND. lwp ) THEN ! error print199 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 200 ! 201 IF( nstop /= 0 .AND. lwp ) THEN ! error print 201 202 WRITE(numout,cform_err) 202 203 WRITE(numout,*) nstop, ' error have been found' … … 216 217 ! 217 218 #if defined key_iomput 218 CALL xios_finalize ! end mpp communications with xios219 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS219 CALL xios_finalize ! end mpp communications with xios 220 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 220 221 #else 221 222 IF( lk_oasis ) THEN 222 CALL cpl_finalize ! end coupling and mpp communications with OASIS223 CALL cpl_finalize ! end coupling and mpp communications with OASIS 223 224 ELSE 224 IF( lk_mpp ) CALL mppstop ! end mpp communications225 IF( lk_mpp ) CALL mppstop ! end mpp communications 225 226 ENDIF 226 227 #endif … … 235 236 !! ** Purpose : initialization of the NEMO GCM 236 237 !!---------------------------------------------------------------------- 237 INTEGER :: ji ! dummy loop indices 238 INTEGER :: ilocal_comm ! local integer 239 INTEGER :: ios, inum ! - - 240 REAL(wp) :: ziglo, zjglo, zkglo, zperio ! local scalars 238 INTEGER :: ji ! dummy loop indices 239 INTEGER :: ios, ilocal_comm ! local integer 241 240 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam 242 241 ! … … 244 243 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 245 244 & nn_timing, nn_diacfl 246 NAMELIST/namcfg/ ln_read_cfg, ln_write_cfg, cp_cfg, jp_cfg, ln_use_jattr245 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 247 246 !!---------------------------------------------------------------------- 248 247 ! … … 260 259 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 261 260 ! 262 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist : Control prints261 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist 263 262 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 264 263 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 265 264 ! 266 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 265 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints 267 266 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 268 267 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 269 ! 270 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 268 269 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark 271 270 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 272 271 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) … … 275 274 ! ! Set global domain size ! (control print return in cltxt2) 276 275 ! !--------------------------! 277 IF( ln_read_cfg ) THEN ! Read sizes in configuration "domain_cfg" file 278 CALL iom_open( 'domain_cfg', inum ) 279 CALL iom_get( inum, 'jpiglo', ziglo ) ; jpiglo = INT( ziglo ) 280 CALL iom_get( inum, 'jpjglo', zjglo ) ; jpjglo = INT( zjglo ) 281 CALL iom_get( inum, 'jpkglo', zkglo ) ; jpkglo = INT( zkglo ) 282 CALL iom_get( inum, 'jperio', zperio ) ; jperio = INT( zperio ) 283 CALL iom_close( inum ) 284 WRITE(cltxt2(1),*) ' ' 285 WRITE(cltxt2(2),*) 'domain_cfg : domain size read in "domain_cfg" file ' 286 WRITE(cltxt2(3),*) '~~~~~~~~~~ ' 287 WRITE(cltxt2(4),*) ' jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo 288 WRITE(cltxt2(5),*) ' global domain type of lateral boundary jperio = ', jperio 289 ! 276 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 277 CALL domain_cfg ( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 278 ! 290 279 ELSE ! user-defined namelist 291 CALL usr_def_nam( cltxt2, clnam, jpiglo, jpjglo, jpkglo, jperio ) 292 ENDIF 293 jpk = jpkglo 280 CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 281 ENDIF 282 ! 283 jpk = jpkglo 294 284 ! 295 285 #if defined key_agrif … … 313 303 IF( Agrif_Root() ) THEN 314 304 IF( lk_oasis ) THEN 315 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis316 CALL xios_initialize( "not used" ,local_comm=ilocal_comm ) ! send nemo communicator to xios305 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 306 CALL xios_initialize( "not used" ,local_comm= ilocal_comm ) ! send nemo communicator to xios 317 307 ELSE 318 308 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios … … 324 314 IF( lk_oasis ) THEN 325 315 IF( Agrif_Root() ) THEN 326 CALL cpl_init( "oceanx", ilocal_comm ) 316 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 327 317 ENDIF 328 318 ! Nodes selection (control print return in cltxt) 329 319 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 330 320 ELSE 331 ilocal_comm = 0 332 ! Nodes selection (control print return in cltxt) 321 ilocal_comm = 0 ! Nodes selection (control print return in cltxt) 333 322 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 334 323 ENDIF … … 340 329 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 341 330 342 IF(lwm) THEN 343 ! write merged namelists from earlier to output namelist now that the 344 ! file has been opened in call to mynode. nammpp has already been 345 ! written in mynode (if lk_mpp_mpi) 331 IF(lwm) THEN ! write merged namelists from earlier to output namelist 332 ! ! now that the file has been opened in call to mynode. 333 ! ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 346 334 WRITE( numond, namctl ) 347 335 WRITE( numond, namcfg ) 348 336 IF( .NOT.ln_read_cfg ) THEN 349 337 DO ji = 1, SIZE(clnam) 350 IF( TRIM(clnam (ji)) /= '' ) WRITE(numond, * ) clnam(ji)! namusr_def print338 IF( TRIM(clnam(ji)) /= '' ) WRITE(numond, * ) clnam(ji) ! namusr_def print 351 339 END DO 352 340 ENDIF … … 394 382 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 395 383 ! 396 397 398 384 WRITE(numout,*) 399 385 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC' 400 386 WRITE(numout,*) ' NEMO team' 401 387 WRITE(numout,*) ' Ocean General Circulation Model' 402 WRITE(numout,*) ' 388 WRITE(numout,*) ' NEMO version 3.7 (2016) ' 403 389 WRITE(numout,*) 404 390 WRITE(numout,*) 405 391 DO ji = 1, SIZE(cltxt) 406 IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) cltxt(ji) 392 IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode 407 393 END DO 408 394 WRITE(numout,*) 409 395 WRITE(numout,*) 410 396 DO ji = 1, SIZE(cltxt2) 411 IF( cltxt2(ji) /= '' ) WRITE(numout,*) cltxt2(ji)! control print of domain size397 IF( TRIM(cltxt2(ji)) /= '' ) WRITE(numout,*) cltxt2(ji) ! control print of domain size 412 398 END DO 413 399 ! 414 WRITE(numout,cform_aaa) 400 WRITE(numout,cform_aaa) ! Flag AAAAAAA 415 401 ! 416 402 ENDIF … … 418 404 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 419 405 CALL nemo_alloc() 406 420 407 ! !-------------------------------! 421 408 ! ! NEMO general initialization ! … … 534 521 CALL dia_tmb_init ! TMB outputs 535 522 CALL dia_25h_init ! 25h mean outputs 536 537 523 ! 538 524 END SUBROUTINE nemo_init … … 577 563 WRITE(numout,*) '~~~~~~~ ' 578 564 WRITE(numout,*) ' Namelist namcfg' 579 WRITE(numout,*) ' read configuration definition files ln_read_cfg = ', ln_read_cfg 580 WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg) 581 WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg 582 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 565 WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg 566 WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg) 567 WRITE(numout,*) ' write configuration definition file ln_write_cfg = ', ln_write_cfg 568 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 569 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 583 570 ENDIF 584 571 ! ! Parameter control … … 679 666 !!---------------------------------------------------------------------- 680 667 ! 681 ierr = oce_alloc () ! ocean 668 ierr = oce_alloc () ! ocean 682 669 ierr = ierr + dia_wri_alloc () 683 670 ierr = ierr + dom_oce_alloc () ! ocean domain … … 855 842 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 856 843 nsndto = nsndto + 1 857 844 isendto(nsndto) = jn 858 845 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 859 846 nsndto = nsndto + 1 860 847 isendto(nsndto) = jn 861 848 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 862 849 nsndto = nsndto + 1 863 864 END 850 isendto(nsndto) = jn 851 ENDIF 865 852 END DO 866 853 nfsloop = 1 -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
r6717 r7200 16 16 !! namcfg namelist parameters 17 17 !!---------------------------------------------------------------------- 18 LOGICAL :: ln_read_cfg !: (=T) read the domain configuration in 'domain_cfg.nc" file 18 LOGICAL :: ln_read_cfg !: (=T) read the domain configuration file or (=F) not 19 CHARACTER(lc) :: cn_domcfg !: filename the configuration file to be read 19 20 LOGICAL :: ln_write_cfg !: (=T) create the domain configuration file 21 CHARACTER(lc) :: cn_domcfg_out !: filename the configuration file to be read 20 22 ! 21 CHARACTER(lc) :: cp_cfg !: name of the configuration22 INTEGER :: jp_cfg !: resolution of the configuration23 23 LOGICAL :: ln_use_jattr !: input file read offset 24 24 ! ! Use file global attribute: open_ocean_jstart to determine start j-row … … 27 27 ! ! with the extended grids used in the under ice shelf configurations to 28 28 ! ! be used without redundant rows when the ice shelves are not in use. 29 ! 29 30 30 31 !!--------------------------------------------------------------------- 31 32 !! Domain Matrix size 32 33 !!--------------------------------------------------------------------- 34 ! configuration name & resolution (required only in ORCA family case) 35 CHARACTER(lc) :: cn_cfg !: name of the configuration 36 INTEGER :: nn_cfg !: resolution of the configuration 33 37 34 38 ! global domain size !!! * total computational domain *
Note: See TracChangeset
for help on using the changeset viewer.
