Changeset 14770 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/STATION_ASF/MY_SRC
- Timestamp:
- 2021-04-30T12:05:23+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/STATION_ASF/MY_SRC
- Files:
-
- 1 deleted
- 8 edited
- 2 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/STATION_ASF/MY_SRC/diawri.F90
r12615 r14770 63 63 CONTAINS 64 64 65 #if defined key_ iomput66 !!---------------------------------------------------------------------- 67 !! 'key_ iomput' use IOM library65 #if defined key_xios 66 !!---------------------------------------------------------------------- 67 !! 'key_xios' use IOM library 68 68 !!---------------------------------------------------------------------- 69 69 INTEGER FUNCTION dia_wri_alloc() … … 387 387 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 388 388 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 389 389 ! 390 CALL iom_close( inum ) 391 ! 390 392 #if defined key_si3 391 393 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 394 CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 392 395 CALL ice_wri_state( inum ) 393 ENDIF 396 CALL iom_close( inum ) 397 ENDIF 398 ! 394 399 #endif 395 !396 CALL iom_close( inum )397 !398 400 END SUBROUTINE dia_wri_state 399 401 -
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/STATION_ASF/MY_SRC/nemogcm.F90
r13286 r14770 30 30 USE step_c1d ! Time stepping loop for the 1D configuration 31 31 ! 32 USE prtctl ! Print control33 32 USE in_out_manager ! I/O manager 34 33 USE lib_mpp ! distributed memory computing 35 34 USE mppini ! shared/distributed memory setting (mpp_init routine) 36 35 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 37 #if defined key_ iomput36 #if defined key_xios 38 37 USE xios ! xIOserver 39 38 #endif … … 47 46 CHARACTER(lc) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing 48 47 48 #if ! defined key_mpi_off 49 ! need MPI_Wtime 50 INCLUDE 'mpif.h' 51 #endif 52 49 53 !!---------------------------------------------------------------------- 50 54 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 51 !! $Id: nemogcm.F90 1 2489 2020-02-28 15:55:11Z davestorkey$55 !! $Id: nemogcm.F90 13286 2020-07-09 15:48:29Z smasson $ 52 56 !! Software governed by the CeCILL license (see ./LICENSE) 53 57 !!---------------------------------------------------------------------- … … 109 113 CALL nemo_closefile 110 114 ! 111 #if defined key_ iomput112 115 #if defined key_xios 116 CALL xios_finalize ! end mpp communications with xios 113 117 #else 114 118 IF( lk_mpp ) CALL mppstop ! end mpp communications … … 144 148 ! !-------------------------------------------------! 145 149 ! 146 #if defined key_ iomput150 #if defined key_xios 147 151 IF( Agrif_Root() ) THEN 148 152 CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios 149 153 ENDIF 150 154 CALL mpp_start( ilocal_comm ) 151 155 #else 152 156 CALL mpp_start( ) 153 157 #endif 154 158 ! … … 163 167 IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 164 168 ! open reference and configuration namelist files 165 166 169 CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm ) 170 CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm ) 167 171 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 168 172 ! open /dev/null file to be able to supress output write easily 169 173 IF( Agrif_Root() ) THEN 170 174 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 171 175 #ifdef key_agrif 172 176 ELSE 173 numnul = Agrif_Parent(numnul) 174 #endif 175 ENDIF 176 ! 177 numnul = Agrif_Parent(numnul) 178 #endif 179 ENDIF 177 180 ! !--------------------! 178 181 ! ! Open listing units ! -> need sn_cfctl from namctl to define lwp … … 215 218 WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 216 219 WRITE(numout,*) 220 221 ! Print the working precision to ocean.output 222 IF (wp == dp) THEN 223 WRITE(numout,*) "Working precision = double-precision" 224 ELSE 225 WRITE(numout,*) "Working precision = single-precision" 226 ENDIF 227 WRITE(numout,*) 217 228 ! 218 229 WRITE(numout,cform_aaa) ! Flag AAAAAAA … … 229 240 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 230 241 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 231 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 242 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 232 243 ! 233 244 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 234 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio)245 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, l_Iperio, l_Jperio, l_NFold, c_NFtype ) 235 246 ELSE ! user-defined namelist 236 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio)247 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, l_Iperio, l_Jperio, l_NFold, c_NFtype ) 237 248 ENDIF 238 249 ! … … 263 274 CALL eos_init ! Equation of state 264 275 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 265 CALL dom_init( Nbb, Nnn, Naa , "OPA") ! Domain276 CALL dom_init( Nbb, Nnn, Naa ) ! Domain 266 277 IF( sn_cfctl%l_prtctl ) & 267 278 & CALL prt_ctl_init ! Print control 268 ! 269 279 270 280 CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers) 271 281 272 ! ! external forcing 282 ! ! external forcing 273 283 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice) 284 285 !#LB: 286 #if defined key_si3 287 IF(lwp) WRITE(numout,*) 'LOLO: nemo_init@nemogcm.F90: shape of fr_i ==>', SIZE(fr_i,1), SIZE(fr_i,2) 288 fr_i(:,:) = 0._wp 289 #endif 290 !#LB. 274 291 275 292 ! … … 302 319 WRITE(numout,*) ' sn_cfctl%l_prttrc = ', sn_cfctl%l_prttrc 303 320 WRITE(numout,*) ' sn_cfctl%l_oasout = ', sn_cfctl%l_oasout 304 WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin 305 WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax 306 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 307 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 321 WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin 322 WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax 323 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 324 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 308 325 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 309 326 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl … … 356 373 !! *** ROUTINE nemo_alloc *** 357 374 !! 358 !! ** Purpose : Allocate all the dynamic arrays of the O PAmodules375 !! ** Purpose : Allocate all the dynamic arrays of the OCE modules 359 376 !! 360 377 !! ** Method : … … 366 383 !!---------------------------------------------------------------------- 367 384 ! 368 ierr = oce_alloc () ! ocean 385 ierr = oce_alloc () ! ocean 369 386 ierr = ierr + dia_wri_alloc() 370 387 ierr = ierr + dom_oce_alloc() ! ocean domain … … 375 392 END SUBROUTINE nemo_alloc 376 393 377 394 378 395 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 379 396 !!---------------------------------------------------------------------- … … 399 416 !!====================================================================== 400 417 END MODULE nemogcm 401 -
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/STATION_ASF/MY_SRC/sbcssm.F90
r12629 r14770 19 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 20 ! 21 #if defined key_si3 22 USE ice !#LB: we need to fill the "tm_su" array! 23 USE sbc_ice !#LB: we need to fill the "alb_ice" array! 24 #endif 25 ! 21 26 USE in_out_manager ! I/O manager 22 27 USE iom ! I/O library … … 48 53 INTEGER :: jf_e3t ! index of first T level thickness 49 54 INTEGER :: jf_frq ! index of fraction of qsr absorbed in the 1st T level 55 #if defined key_si3 56 INTEGER :: jf_ifr ! index of sea-ice concentration !#LB 57 INTEGER :: jf_tic ! index of sea-ice surface temperature !#LB 58 INTEGER :: jf_ial ! index of sea-ice surface albedo !#LB 59 #endif 50 60 51 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d ! structure of input fields (file information, fields read) … … 54 64 !!---------------------------------------------------------------------- 55 65 !! NEMO/SAS 4.0 , NEMO Consortium (2018) 56 !! $Id: sbcssm.F90 1 2615 2020-03-26 15:18:49Z laurent$66 !! $Id: sbcssm.F90 13286 2020-07-09 15:48:29Z smasson $ 57 67 !! Software governed by the CeCILL license (see ./LICENSE) 58 68 !!---------------------------------------------------------------------- … … 73 83 ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 74 84 ! 75 INTEGER :: ji, jj 85 INTEGER :: ji, jj, jl ! dummy loop indices 76 86 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 77 87 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation … … 84 94 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 85 95 ! 86 IF( ln_3d_uve ) THEN 87 IF( .NOT. ln_linssh ) THEN 88 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 89 ELSE 90 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 91 ENDIF 92 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 93 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 94 ELSE 95 IF( .NOT. ln_linssh ) THEN 96 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 97 ELSE 98 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 99 ENDIF 100 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 101 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 102 ENDIF 103 ! 96 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 97 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 98 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 99 ! 100 !#LB: 101 #if defined key_si3 102 !IF(lwp) WRITE(numout,*) 'LOLO: sbc_ssm()@sbcssm.F90 => fill "tm_su" and other fields at kt =', kt 103 !IF(lwp) WRITE(numout,*) 'LOLO: sbc_ssm()@sbcssm.F90 => shape of at_i ==>', SIZE(at_i,1), SIZE(at_i,2) 104 at_i (:,:) = sf_ssm_2d(jf_ifr)%fnow(:,:,1) * tmask(:,:,1) ! sea-ice concentration [fraction] 105 tm_su(:,:) = sf_ssm_2d(jf_tic)%fnow(:,:,1) * tmask(:,:,1) ! sea-ice surface temperature, read in [K] !#LB 106 sst_m(:,:) = sf_ssm_2d(jf_ial)%fnow(:,:,1) * tmask(:,:,1) ! !!!sst_m AS TEMPORARY ARRAY !!! sea-ice albedo [fraction] 107 DO jl = 1, jpl 108 !IF(lwp) WRITE(numout,*) 'LOLO: sbc_ssm()@sbcssm.F90 => fill "t_su" for ice cat =', jl 109 a_i (:,:,jl) = at_i (:,:) 110 a_i_b (:,:,jl) = at_i (:,:) 111 t_su (:,:,jl) = tm_su(:,:) 112 alb_ice(:,:,jl) = sst_m(:,:) 113 END DO 114 !IF(lwp) WRITE(numout,*) '' 115 #endif 116 !#LB. 104 117 sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1) ! temperature 105 118 sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1) ! salinity 106 119 ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 107 IF( ln_read_frq ) THEN 108 frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! solar penetration 109 ELSE 110 frq_m(:,:) = 1._wp 111 ENDIF 120 frq_m(:,:) = 1._wp 112 121 ELSE 113 122 sss_m(:,:) = 35._wp ! =35. to obtain a physical value for the freezing point … … 116 125 ssv_m(:,:) = 0._wp 117 126 ssh_m(:,:) = 0._wp 118 IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D119 127 frq_m(:,:) = 1._wp ! - - 120 128 ssh (:,:,Kmm) = 0._wp ! - - … … 136 144 CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m - : ', mask1=vmask ) 137 145 CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m - : ', mask1=tmask ) 138 IF( .NOT.ln_linssh ) CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m - : ', mask1=tmask )139 IF( ln_read_frq ) CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m - : ', mask1=tmask )140 146 ENDIF 141 147 ! … … 146 152 CALL iom_put( 'sss_m', sss_m ) 147 153 CALL iom_put( 'ssh_m', ssh_m ) 148 IF( .NOT.ln_linssh ) CALL iom_put( 'e3t_m', e3t_m )149 IF( ln_read_frq ) CALL iom_put( 'frq_m', frq_m )150 154 ENDIF 151 155 ! … … 175 179 TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 176 180 !! 181 TYPE(FLD_N) :: sn_ifr, sn_tic, sn_ial 182 !! 177 183 NAMELIST/namsbc_sas/ l_sasread, cn_dir, ln_3d_uve, ln_read_frq, & 178 & sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 184 & sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq, & 185 & sn_ifr, sn_tic, sn_ial 179 186 !!---------------------------------------------------------------------- 180 187 ! … … 196 203 WRITE(numout,*) ' Namelist namsbc_sas' 197 204 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 198 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve199 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq200 205 ENDIF 201 206 ! … … 218 223 IF( lwp ) WRITE(numout,*) ' ==>>> No freshwater budget adjustment needed with StandAlone Surface scheme' 219 224 nn_fwb = 0 225 ENDIF 226 IF( ln_closea ) THEN 227 IF( lwp ) WRITE(numout,*) ' ==>>> No closed seas adjustment needed with StandAlone Surface scheme' 228 ln_closea = .false. 220 229 ENDIF 221 230 … … 230 239 !! and the rest of the logic should still work 231 240 ! 232 jf_tem = 1 ; jf_ssh = 3 ! default 2D fields index 233 jf_sal = 2 ; jf_frq = 4 ! 234 ! 235 IF( ln_3d_uve ) THEN 236 jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 ! define 3D fields index 237 nfld_3d = 2 + COUNT( (/.NOT.ln_linssh/) ) ! number of 3D fields to read 238 nfld_2d = 3 + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 239 ELSE 240 jf_usp = 4 ; jf_e3t = 6 ! update 2D fields index 241 jf_vsp = 5 ; jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) ) 242 ! 243 nfld_3d = 0 ! no 3D fields to read 244 nfld_2d = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 245 ENDIF 241 !#LB: 242 jf_tem = 1 243 jf_sal = 2 244 jf_ssh = 3 245 jf_usp = 4 246 jf_vsp = 5 247 ! 248 nfld_3d = 0 249 nfld_2d = 5 250 ! 251 #if defined key_si3 252 jf_ifr = jf_vsp + 1 253 jf_tic = jf_vsp + 2 254 jf_ial = jf_vsp + 3 255 nfld_2d = nfld_2d + 3 256 257 !IF(lwp) WRITE(numout,*) 'LOLO: nfld_2d =', nfld_2d 258 !IF(lwp) WRITE(numout,*) 'LOLO: jf_tem =', jf_tem 259 !IF(lwp) WRITE(numout,*) 'LOLO: jf_sal =', jf_sal 260 !IF(lwp) WRITE(numout,*) 'LOLO: jf_ssh =', jf_ssh 261 !IF(lwp) WRITE(numout,*) 'LOLO: jf_usp =', jf_usp 262 !IF(lwp) WRITE(numout,*) 'LOLO: jf_vsp =', jf_vsp 263 !IF(lwp) WRITE(numout,*) 'LOLO: jf_ifr =', jf_ifr 264 !IF(lwp) WRITE(numout,*) 'LOLO: jf_tic =', jf_tic 265 !IF(lwp) WRITE(numout,*) 'LOLO: jf_ial =', jf_ial 266 !IF(lwp) WRITE(numout,*) '' 267 #endif 268 !#LB. 246 269 ! 247 270 IF( nfld_3d > 0 ) THEN … … 252 275 slf_3d(jf_usp) = sn_usp 253 276 slf_3d(jf_vsp) = sn_vsp 254 IF( .NOT.ln_linssh ) slf_3d(jf_e3t) = sn_e3t255 277 ENDIF 256 278 ! … … 261 283 ENDIF 262 284 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 263 IF( ln_read_frq ) slf_2d(jf_frq) = sn_frq 264 IF( .NOT. ln_3d_uve ) THEN 265 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 266 IF( .NOT.ln_linssh ) slf_2d(jf_e3t) = sn_e3t 267 ENDIF 285 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 268 286 ENDIF 287 ! 288 #if defined key_si3 289 slf_2d(jf_ifr) = sn_ifr !#LB 290 slf_2d(jf_tic) = sn_tic !#LB 291 slf_2d(jf_ial) = sn_ial !#LB 292 #endif 269 293 ! 270 294 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. -
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/STATION_ASF/MY_SRC/step_c1d.F90
r13226 r14770 7 7 !! 3.0 ! 2008-04 (G. Madec) redo the adaptation to include SBC 8 8 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme 9 !! 4. 1 ! 2019-12(L. Brodeau) STATION_ASF test-case9 !! 4.x ! 2020-11 (L. Brodeau) STATION_ASF test-case 10 10 !!---------------------------------------------------------------------- 11 11 #if defined key_c1d … … 22 22 PRIVATE 23 23 24 PUBLIC stp_c1d ! called by nemogcm.F9024 PUBLIC stp_c1d ! called by nemogcm.F90 25 25 26 26 !!---------------------------------------------------------------------- 27 27 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 28 !! $Id: step_c1d.F90 1 2377 2020-02-12 14:39:06Z acc$28 !! $Id: step_c1d.F90 13802 2020-11-17 09:21:55Z gsamson $ 29 29 !! Software governed by the CeCILL license (see ./LICENSE) 30 30 !!---------------------------------------------------------------------- … … 36 36 !! 37 37 !! ** Purpose : - Time stepping of SBC including sea ice (dynamic and thermodynamic eqs.) 38 !! - Time stepping of O PA(momentum and active tracer eqs.)38 !! - Time stepping of OCE (momentum and active tracer eqs.) 39 39 !! - Time stepping of TOP (passive tracer eqs.) 40 40 !! … … 51 51 ! 52 52 INTEGER :: jk ! dummy loop indice 53 INTEGER :: indic ! error indicator if < 054 53 !! --------------------------------------------------------------------- 55 56 indic = 0 ! reset to no error condition57 54 IF( kstp == nit000 ) CALL iom_init( "nemo") ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 58 55 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 59 CALL iom_setkt( kstp - nit000 + 1, "nemo" ) ! say to iom that we are at time step kstp56 CALL iom_setkt( kstp - nit000 + 1, "nemo" ) ! say to iom that we are at time step kstp 60 57 61 58 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 62 59 ! Update data, open boundaries, surface boundary condition (including sea-ice) 63 60 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 64 CALL sbc ( kstp, Nbb, Nnn ) ! Sea Boundary Condition (including sea-ice)61 CALL sbc ( kstp, Nbb, Nnn ) ! Sea Boundary Condition (including sea-ice) 65 62 66 63 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 67 64 ! diagnostics and outputs 68 65 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 69 CALL dia_wri( kstp, Nnn ) ! ocean model: outputs66 CALL dia_wri( kstp, Nnn ) ! ocean model: outputs 70 67 71 68 ! Swap time levels … … 78 75 ! Control and restarts 79 76 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 80 CALL stp_ctl( kstp, Nnn ) 81 77 CALL stp_ctl( kstp, Nnn ) 82 78 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 83 79 IF( lrst_oce ) CALL rst_write( kstp, Nbb, Nnn ) ! write output ocean restart file 84 80 ! 85 #if defined key_ iomput81 #if defined key_xios 86 82 IF( kstp == nitend .OR. nstop > 0 ) CALL xios_context_finalize() ! needed for XIOS 87 83 ! -
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/STATION_ASF/MY_SRC/stpctl.F90
r13616 r14770 31 31 PUBLIC stp_ctl ! routine called by step.F90 32 32 33 INTEGER :: nrunid ! netcdf file id 34 INTEGER, DIMENSION(3) :: nvarid ! netcdf variable id 33 INTEGER, PARAMETER :: jpvar = 3 34 INTEGER :: nrunid ! netcdf file id 35 INTEGER, DIMENSION(jpvar) :: nvarid ! netcdf variable id 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/SAS 4.0 , NEMO Consortium (2018) … … 43 44 !!---------------------------------------------------------------------- 44 45 !! *** ROUTINE stp_ctl *** 45 !! 46 !! 46 47 !! ** Purpose : Control the run 47 48 !! … … 59 60 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 60 61 !! 62 INTEGER, PARAMETER :: jptst = 3 61 63 INTEGER :: ji ! dummy loop indices 62 64 INTEGER :: idtime, istatus 63 INTEGER , DIMENSION( 4):: iareasum, iareamin, iareamax64 INTEGER , DIMENSION(3, 3):: iloc ! min/max loc indices65 INTEGER , DIMENSION(jptst) :: iareasum, iareamin, iareamax 66 INTEGER , DIMENSION(3,jptst) :: iloc ! min/max loc indices 65 67 REAL(wp) :: zzz ! local real 66 REAL(wp), DIMENSION(4) :: zmax, zmaxlocal 68 REAL(wp), DIMENSION(jpvar+1) :: zmax 69 REAL(wp), DIMENSION(jptst) :: zmaxlocal 67 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 68 71 LOGICAL, DIMENSION(jpi,jpj) :: llmsk … … 72 75 ! 73 76 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 74 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 77 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 75 78 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 76 79 ! … … 98 101 istatus = NF90_ENDDEF(nrunid) 99 102 ENDIF 100 ! 103 ! 101 104 ENDIF 102 105 ! … … 110 113 ! !== done by all processes at every time step ==! 111 114 ! 112 llmsk( 1:Nis1,:) = .FALSE.! exclude halos from the checked region113 llmsk(Nie 1:jpi,:) = .FALSE.114 llmsk(:, 1:Njs1) = .FALSE.115 llmsk(:,Nje 1:jpj) = .FALSE.115 llmsk( 1:nn_hls,:) = .FALSE. ! exclude halos from the checked region 116 llmsk(Nie0+1: jpi,:) = .FALSE. 117 llmsk(:, 1:nn_hls) = .FALSE. 118 llmsk(:,Nje0+1: jpj) = .FALSE. 116 119 ! 117 120 llmsk(Nis0:Nie0,Njs0:Nje0) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp ! test only the inner domain … … 122 125 zmax(2) = MAXVAL( ABS( qns(:,:) ), mask = llmsk ) ! max non-solar heat flux 123 126 zmax(3) = MAXVAL( ABS( emp(:,:) ), mask = llmsk ) ! max E-P 124 zmax( 4) = REAL( nstop, wp )! stop indicator127 zmax(jpvar+1) = REAL( nstop, wp ) ! stop indicator 125 128 ! 126 129 ! !== get global extrema ==! 127 130 ! !== done by all processes if writting run.stat ==! 128 131 IF( ll_colruns ) THEN 129 zmaxlocal(:) = zmax( :)130 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 131 nstop = NINT( zmax( 4) )! update nstop indicator (now sheared among all local domains)132 zmaxlocal(:) = zmax(1:jptst) 133 CALL mpp_max( "stpctl", zmax ) ! max over the global domain: ok even of ll_0oce = .true. 134 nstop = NINT( zmax(jpvar+1) ) ! update nstop indicator (now sheared among all local domains) 132 135 ELSE 133 136 ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 134 IF( ll_0oce ) zmax(1:3) = 0._wp ! default "valid" values... 135 ENDIF 136 ! !== error handling ==! 137 IF( ll_0oce ) zmax(1:jptst) = 0._wp ! default "valid" values... 138 ENDIF 137 139 ! !== write "run.stat" files ==! 138 140 ! !== done only by 1st subdomain at writting timestep ==! 139 141 IF( ll_wrtruns ) THEN 140 WRITE(numrun,9500) kt, zmax(1 ), zmax(2), zmax(3)141 DO ji = 1, 3142 WRITE(numrun,9500) kt, zmax(1:jptst) 143 DO ji = 1, jpvar 142 144 istatus = NF90_PUT_VAR( nrunid, nvarid(ji), (/zmax(ji)/), (/kt/), (/1/) ) 143 145 END DO 144 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid)146 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 145 147 END IF 146 148 ! !== error handling ==! 147 149 ! !== done by all processes at every time step ==! 148 150 ! 149 IF( zmax(1) > 5._wp .OR. & ! too large wind stress ( > 5 N/m^2 )150 & zmax(2) > 2000._wp .OR. & ! too large non-solar heat flux ( > 2000 W/m^2 )151 & zmax(3) > 1.E-3_wp .OR. & ! too large net freshwater flux ( > 1.E-3 kg/m^2/s )152 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests153 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests151 IF( zmax(1) > 5._wp .OR. & ! too large wind stress ( > 5 N/m^2 ) 152 & zmax(2) > 2000._wp .OR. & ! too large non-solar heat flux ( > 2000 W/m^2 ) 153 & zmax(3) > 1.E-3_wp .OR. & ! too large net freshwater flux ( > 1.E-3 kg/m^2/s ) 154 & ISNAN( SUM(zmax(1:jptst)) ) .OR. & ! NaN encounter in the tests 155 & ABS( SUM(zmax(1:jptst)) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 154 156 ! 155 157 iloc(:,:) = 0 … … 158 160 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 159 161 ! get global loc on the min/max 160 CALL mpp_maxloc( 'stpctl', taum(:,:) , llmsk, zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 162 CALL mpp_maxloc( 'stpctl', taum(:,:) , llmsk, zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 161 163 CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), llmsk, zzz, iloc(1:2,2) ) 162 164 CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), llmsk, zzz, iloc(1:2,3) ) 163 165 ! find which subdomain has the max. 164 166 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 165 DO ji = 1, 4167 DO ji = 1, jptst 166 168 IF( zmaxlocal(ji) == zmax(ji) ) THEN 167 169 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 … … 176 178 iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk ) 177 179 iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk ) 178 DO ji = 1, 3! local domain indices ==> global domain indices, excluding halos180 DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos 179 181 iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 180 182 END DO … … 194 196 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 195 197 ! 196 IF( ll_colruns . or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files198 IF( ll_colruns .OR. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 197 199 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 198 200 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) … … 235 237 !!---------------------------------------------------------------------- 236 238 WRITE(clkt , '(i9)') kt 237 239 238 240 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 239 241 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF -
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
r13286 r14770 12 12 13 13 !!---------------------------------------------------------------------- 14 !! usr_def_hgr : initialize the horizontal mesh 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain 16 17 USE c1d , ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist 17 18 USE par_oce ! ocean space and time domain … … 21 22 USE in_out_manager ! I/O manager 22 23 USE lib_mpp ! MPP library 23 24 24 25 IMPLICIT NONE 25 26 PRIVATE … … 29 30 !!---------------------------------------------------------------------- 30 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 31 !! $Id: usrdef_hgr.F90 1 2489 2020-02-28 15:55:11Z davestorkey $32 !! $Id: usrdef_hgr.F90 13216 2020-07-02 09:25:49Z rblod $ 32 33 !! Software governed by the CeCILL license (see ./LICENSE) 33 34 !!---------------------------------------------------------------------- … … 48 49 !! 49 50 !! Here STATION_ASF configuration : 50 !! Rectangular 3x3 domain 51 !! Rectangular 3x3 domain 51 52 !! - Located at 150E-50N 52 !! - a constant horizontal resolution 53 !! - a constant horizontal resolution 53 54 !! 54 !! ** Action : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 55 !! ** Action : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 55 56 !! - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane) 56 57 !! - define i- & j-scale factors at t-, u-, v- and f-points (in meters) … … 63 64 REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1t, pe1u, pe1v, pe1f ! i-scale factors [m] 64 65 REAL(wp), DIMENSION(:,:), INTENT(out) :: pe2t, pe2u, pe2v, pe2f ! j-scale factors [m] 65 INTEGER , INTENT(out) :: ke1e2u_v ! =1 u- & v-surfaces computed here, =0 otherwise 66 INTEGER , INTENT(out) :: ke1e2u_v ! =1 u- & v-surfaces computed here, =0 otherwise 66 67 REAL(wp), DIMENSION(:,:), INTENT(out) :: pe1e2u, pe1e2v ! u- & v-surfaces (if reduction in strait) [m2] 67 68 ! … … 77 78 ! ! longitude 78 79 plamt(:,:) = rn_lon1d 79 plamu(:,:) = rn_lon1d 80 plamu(:,:) = rn_lon1d 80 81 plamv(:,:) = rn_lon1d 81 82 plamf(:,:) = rn_lon1d … … 93 94 pe1f(:,:) = 100. ; pe2f(:,:) = 100. 94 95 ! 95 ! ! NO reduction of grid size in some straits 96 ! ! NO reduction of grid size in some straits 96 97 ke1e2u_v = 0 ! ==>> u_ & v_surfaces will be computed in dom_ghr routine 97 98 pe1e2u(:,:) = 0._wp ! CAUTION: set to zero to avoid error with some compilers that … … 100 101 ! 101 102 ! !== Coriolis parameter ==! 102 zf0 = 2._wp * omega * SIN( rad * rn_lat1d ) 103 zf0 = 2._wp * omega * SIN( rad * rn_lat1d ) 103 104 pff_f(:,:) = zf0 104 pff_t(:,:) = zf0 105 pff_t(:,:) = zf0 105 106 kff = 1 ! indicate to skip computing Coriolis parameter afterward 106 107 ! -
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
r13286 r14770 13 13 !!---------------------------------------------------------------------- 14 14 !! usr_def_nam : read user defined namelist and set global domain size 15 !! usr_def_hgr : initialize the horizontal mesh 15 !! usr_def_hgr : initialize the horizontal mesh 16 16 !!---------------------------------------------------------------------- 17 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain 17 18 USE par_oce ! ocean space and time domain 18 19 USE phycst ! physical constants … … 20 21 USE in_out_manager ! I/O manager 21 22 USE lib_mpp ! MPP library 22 23 23 24 IMPLICIT NONE 24 25 PRIVATE … … 31 32 !!---------------------------------------------------------------------- 32 33 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 33 !! $Id: usrdef_nam.F90 1 2377 2020-02-12 14:39:06Z acc $34 !! $Id: usrdef_nam.F90 13216 2020-07-02 09:25:49Z rblod $ 34 35 !! Software governed by the CeCILL license (see ./LICENSE) 35 36 !!---------------------------------------------------------------------- 36 37 CONTAINS 37 38 38 SUBROUTINE usr_def_nam( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio)39 SUBROUTINE usr_def_nam( cd_cfg, kk_cfg, kpi, kpj, kpk, ldIperio, ldJperio, ldNFold, cdNFtype ) 39 40 !!---------------------------------------------------------------------- 40 41 !! *** ROUTINE dom_nam *** 41 !! 42 !! 42 43 !! ** Purpose : read user defined namelist and define the domain size 43 44 !! … … 48 49 !! ** input : - namusr_def namelist found in namelist_cfg 49 50 !!---------------------------------------------------------------------- 50 CHARACTER(len=*), INTENT(out) :: cd_cfg ! configuration name 51 INTEGER , INTENT(out) :: kk_cfg ! configuration resolution 52 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 53 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. 51 CHARACTER(len=*), INTENT(out) :: cd_cfg ! configuration name 52 INTEGER , INTENT(out) :: kk_cfg ! configuration resolution 53 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 54 LOGICAL , INTENT(out) :: ldIperio, ldJperio ! i- and j- periodicity 55 LOGICAL , INTENT(out) :: ldNFold ! North pole folding 56 CHARACTER(len=1), INTENT(out) :: cdNFtype ! Folding type: T or F 54 57 ! 55 58 INTEGER :: ios ! Local integer … … 72 75 ! 73 76 ! ! Set the lateral boundary condition of the global domain 74 kperio = 7 ! C1D configuration : 3x3 basin with cyclic Est-West and Norht-South condition 77 ldIperio = .TRUE. ; ldJperio = .true. ! C1D configuration : 3x3 basin with cyclic Est-West and Norht-South condition 78 ldNFold = .FALSE. ; cdNFtype = '-' 75 79 ! 76 80 ! ! control print … … 84 88 WRITE(numout,*) ' number of model levels kpk = ', kpk 85 89 WRITE(numout,*) ' ' 86 WRITE(numout,*) ' Lateral b.c. of the domain set to jperio = ', kperio87 90 ENDIF 88 91 ! -
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90
r12629 r14770 13 13 !!---------------------------------------------------------------------- 14 14 !! usr_def_zgr : user defined vertical coordinate system 15 !! zgr_z : reference 1D z-coordinate 15 !! zgr_z : reference 1D z-coordinate 16 16 !! zgr_top_bot: ocean top and bottom level indices 17 17 !! zgr_zco : 3D verticl coordinate in pure z-coordinate case … … 31 31 !!---------------------------------------------------------------------- 32 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 33 !! $Id: usrdef_zgr.F90 1 2377 2020-02-12 14:39:06Z acc$33 !! $Id: usrdef_zgr.F90 13226 2020-07-02 14:24:31Z orioltp $ 34 34 !! Software governed by the CeCILL license (see ./LICENSE) 35 35 !!---------------------------------------------------------------------- … … 54 54 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m] 55 55 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m] 56 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors 56 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors 57 57 INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level 58 58 !!---------------------------------------------------------------------- … … 85 85 pe3uw(:,:,1) = rn_dept1 ! LB??? 86 86 pe3vw(:,:,1) = rn_dept1 ! LB??? 87 87 88 88 !! 2nd level, technically useless (only for the sake of code stability) 89 89 pdept_1d(2) = 3._wp*rn_dept1
Note: See TracChangeset
for help on using the changeset viewer.