Changeset 12655
- Timestamp:
- 2020-04-03T11:35:09+02:00 (3 years ago)
- Location:
- NEMO/branches/2020/r12581_ticket2418
- Files:
-
- 31 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12581_ticket2418/cfgs/ref_cfgs.txt
r12377 r12655 7 7 ORCA2_OFF_TRC OCE TOP OFF 8 8 ORCA2_SAS_ICE OCE ICE NST SAS 9 ORCA2_ICE_PISCES OCE TOP ICE NST 9 ORCA2_ICE_PISCES OCE TOP ICE NST ABL 10 10 ORCA2_ICE_ABL OCE ICE ABL 11 ORCA2_SAS_ICE_ABL OCE SAS ICE ABL12 ORCA2_ICE OCE ICE13 11 SPITZ12 OCE ICE 14 12 WED025 OCE ICE 15 eORCA025_ICE OCE ICE16 eORCA025_ICE_ABL OCE ICE ABL17 eORCA025_SAS_ICE_ABL OCE SAS ICE ABL -
NEMO/branches/2020/r12581_ticket2418/src/ABL/ablrst.F90
r11945 r12655 74 74 ENDIF 75 75 ! 76 CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka )76 CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka, cdcomp = 'ABL' ) 77 77 lrst_abl = .TRUE. 78 78 ENDIF … … 146 146 ENDIF 147 147 148 CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar , kdlev = jpka)148 CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar ) 149 149 150 150 ! Time info -
NEMO/branches/2020/r12581_ticket2418/src/ICE/icectl.F90
r12544 r12655 331 331 IF(lwp) WRITE(numout,*) 332 332 333 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )333 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 334 334 335 335 CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 ) ! ice mass spurious lost/gain -
NEMO/branches/2020/r12581_ticket2418/src/ICE/iceistate.F90
r12489 r12655 436 436 !!clem: output of initial state should be written here but it is impossible because 437 437 !! the ocean and ice are in the same file 438 !! CALL dia_wri_state( 'output.init' )438 !! CALL dia_wri_state( Kmm, 'output.init' ) 439 439 ! 440 440 END SUBROUTINE ice_istate -
NEMO/branches/2020/r12581_ticket2418/src/ICE/icerst.F90
r12377 r12655 80 80 ENDIF 81 81 ! 82 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl )82 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 83 83 lrst_ice = .TRUE. 84 84 ENDIF … … 185 185 ENDIF 186 186 187 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir , kdlev = jpl)187 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir ) 188 188 189 189 ! test if v_i exists -
NEMO/branches/2020/r12581_ticket2418/src/OCE/BDY/bdydta.F90
r12547 r12655 116 116 END DO 117 117 ENDIF 118 IF( dta_bdy(jbdy)%lneed_dyn2d ) THEN118 IF( dta_bdy(jbdy)%lneed_dyn2d .AND. ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer 119 119 igrd = 2 120 120 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init … … 228 228 ! tidal harmonic forcing ONLY: initialise arrays 229 229 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d 230 IF( dta_alias%lneed_ssh ) dta_alias%ssh(:) = 0._wp231 IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp232 IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp230 IF( dta_alias%lneed_ssh .AND. ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 231 IF( dta_alias%lneed_dyn2d .AND. ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 232 IF( dta_alias%lneed_dyn2d .AND. ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 233 233 ENDIF 234 234 … … 237 237 ! 238 238 igrd = 2 ! zonal velocity 239 dta_alias%u2d(:) = 0._wp ! compute barotrope zonal velocity and put it in u2d240 239 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 241 240 ii = idx_bdy(jbdy)%nbi(ib,igrd) 242 241 ij = idx_bdy(jbdy)%nbj(ib,igrd) 242 dta_alias%u2d(ib) = 0._wp ! compute barotrope zonal velocity and put it in u2d 243 243 DO ik = 1, jpkm1 244 244 dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) … … 250 250 END DO 251 251 igrd = 3 ! meridional velocity 252 dta_alias%v2d(:) = 0._wp ! compute barotrope meridional velocity and put it in v2d253 252 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 254 253 ii = idx_bdy(jbdy)%nbi(ib,igrd) 255 254 ij = idx_bdy(jbdy)%nbj(ib,igrd) 255 dta_alias%v2d(ib) = 0._wp ! compute barotrope meridional velocity and put it in v2d 256 256 DO ik = 1, jpkm1 257 257 dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) … … 275 275 276 276 #if defined key_si3 277 IF( dta_alias%lneed_ice ) THEN277 IF( dta_alias%lneed_ice .AND. idx_bdy(jbdy)%nblen(1) > 0 ) THEN 278 278 ! fill temperature and salinity arrays 279 279 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) -
NEMO/branches/2020/r12581_ticket2418/src/OCE/DIA/diaar5.F90
r12489 r12655 32 32 REAL(wp) :: vol0 ! ocean volume (interior domain) 33 33 REAL(wp) :: area_tot ! total ocean surface (interior domain) 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: area ! cell surface (interior domain)35 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: thick0 ! ocean thickness (interior domain) 36 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity … … 54 53 !!---------------------------------------------------------------------- 55 54 ! 56 ALLOCATE( area(jpi,jpj),thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc )55 ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 57 56 ! 58 57 CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) … … 90 89 ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 91 90 ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 92 zarea_ssh(:,:) = area(:,:) * ssh(:,:,Kmm)93 ENDIF 94 ! 95 CALL iom_put( 'e2u' , e2u (:,:) )96 CALL iom_put( 'e1v' , e1v (:,:) )97 CALL iom_put( 'areacello', area(:,:) )91 zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm) 92 ENDIF 93 ! 94 CALL iom_put( 'e2u' , e2u (:,:) ) 95 CALL iom_put( 'e1v' , e1v (:,:) ) 96 CALL iom_put( 'areacello', e1e2t(:,:) ) 98 97 ! 99 98 IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' ) ) THEN 100 99 zrhd(:,:,jpk) = 0._wp ! ocean volume ; rhd is used as workspace 101 100 DO jk = 1, jpkm1 102 zrhd(:,:,jk) = area(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)101 zrhd(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 103 102 END DO 104 103 CALL iom_put( 'volcello' , zrhd(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 … … 151 150 END IF 152 151 ! 153 zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) )152 zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 154 153 zssh_steric = - zarho / area_tot 155 154 CALL iom_put( 'sshthster', zssh_steric ) … … 177 176 END IF 178 177 ! 179 zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) )178 zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 180 179 zssh_steric = - zarho / area_tot 181 180 CALL iom_put( 'sshsteric', zssh_steric ) … … 191 190 ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 192 191 DO_3D_11_11( 1, jpkm1 ) 193 zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm)192 zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) 194 193 ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 195 194 ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm) … … 237 236 z2d(:,:) = 0._wp 238 237 DO jk = 1, jpkm1 239 z2d(:,:) = z2d(:,:) + area(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk)238 z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 240 239 END DO 241 240 ztemp = glob_sum( 'diaar5', z2d(:,:) ) … … 244 243 ! 245 244 IF( iom_use( 'ssttot' ) ) THEN ! Output potential temperature in case we use TEOS-10 246 zsst = glob_sum( 'diaar5', area(:,:) * ztpot(:,:,1) )245 zsst = glob_sum( 'diaar5', e1e2t(:,:) * ztpot(:,:,1) ) 247 246 CALL iom_put( 'ssttot', zsst / area_tot ) 248 247 ENDIF … … 259 258 ELSE 260 259 IF( iom_use('ssttot') ) THEN ! Output sst in case we use EOS-80 261 zsst = glob_sum( 'diaar5', area(:,:) * ts(:,:,1,jp_tem,Kmm) )260 zsst = glob_sum( 'diaar5', e1e2t(:,:) * ts(:,:,1,jp_tem,Kmm) ) 262 261 CALL iom_put('ssttot', zsst / area_tot ) 263 262 ENDIF … … 375 374 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 376 375 377 area(:,:) = e1e2t(:,:) 378 area_tot = glob_sum( 'diaar5', area(:,:) ) 376 area_tot = glob_sum( 'diaar5', e1e2t(:,:) ) 379 377 380 378 ALLOCATE( zvol0(jpi,jpj) ) … … 383 381 DO_3D_11_11( 1, jpkm1 ) 384 382 idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 385 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * area(ji,jj)383 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * e1e2t(ji,jj) 386 384 thick0(ji,jj) = thick0(ji,jj) + idep 387 385 END_3D -
NEMO/branches/2020/r12581_ticket2418/src/OCE/DIA/diamlr.F90
r12377 r12655 84 84 INTEGER :: itide ! Number of available tidal components 85 85 REAL(wp) :: ztide_phase ! Tidal-constituent phase at adatrj=0 86 CHARACTER (LEN=4), DIMENSION(jpmax_harmo) :: ctide_selected = ' 86 CHARACTER (LEN=4), DIMENSION(jpmax_harmo) :: ctide_selected = 'n/a ' 87 87 TYPE(tide_harmonic), DIMENSION(:), POINTER :: stideconst 88 88 … … 145 145 ! Retrieve information (frequency, phase, nodal correction) about all 146 146 ! available tidal constituents for placeholder substitution below 147 ctide_selected(1:34) = (/ 'Mf', 'Mm', 'Ssa', 'Mtm', 'Msf', & 148 & 'Msqm', 'Sa', 'K1', 'O1', 'P1', & 149 & 'Q1', 'J1', 'S1', 'M2', 'S2', 'N2', & 150 & 'K2', 'nu2', 'mu2', '2N2', 'L2', & 151 & 'T2', 'eps2', 'lam2', 'R2', 'M3', & 152 & 'MKS2', 'MN4', 'MS4', 'M4', 'N4', & 153 & 'S4', 'M6', 'M8' /) 147 ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 148 ctide_selected(1:34) = (/ 'Mf ', 'Mm ', 'Ssa ', 'Mtm ', 'Msf ', & 149 & 'Msqm', 'Sa ', 'K1 ', 'O1 ', 'P1 ', & 150 & 'Q1 ', 'J1 ', 'S1 ', 'M2 ', 'S2 ', 'N2 ', & 151 & 'K2 ', 'nu2 ', 'mu2 ', '2N2 ', 'L2 ', & 152 & 'T2 ', 'eps2', 'lam2', 'R2 ', 'M3 ', & 153 & 'MKS2', 'MN4 ', 'MS4 ', 'M4 ', 'N4 ', & 154 & 'S4 ', 'M6 ', 'M8 ' /) 154 155 CALL tide_init_harmonics(ctide_selected, stideconst) 155 156 itide = size(stideconst) -
NEMO/branches/2020/r12581_ticket2418/src/OCE/DIA/diawri.F90
r12493 r12655 924 924 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 925 925 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 926 927 #if defined key_si3 928 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 929 #else 930 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 931 #endif 932 926 ! 927 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 928 ! 933 929 CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) ) ! now temperature 934 930 CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) ) ! now salinity … … 943 939 CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep ) ! now k-velocity 944 940 CALL iom_rstput( 0, 0, inum, 'ht' , ht ) ! now water column height 945 941 ! 946 942 IF ( ln_isf ) THEN 947 943 IF (ln_isfcav_mlt) THEN … … 949 945 CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav ) ! now k-velocity 950 946 CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav ) ! now k-velocity 951 CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav, 8)) ! now k-velocity952 CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav, 8)) ! now k-velocity953 CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav, 8), ktype = jp_i1 )947 CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) ) ! now k-velocity 948 CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) ) ! now k-velocity 949 CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 ) 954 950 END IF 955 951 IF (ln_isfpar_mlt) THEN 956 CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par, 8)) ! now k-velocity952 CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) ) ! now k-velocity 957 953 CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par ) ! now k-velocity 958 954 CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par ) ! now k-velocity 959 955 CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par ) ! now k-velocity 960 CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par, 8)) ! now k-velocity961 CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par, 8)) ! now k-velocity962 CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par, 8), ktype = jp_i1 )956 CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) ) ! now k-velocity 957 CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) ) ! now k-velocity 958 CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 ) 963 959 END IF 964 960 END IF 965 961 ! 966 962 IF( ALLOCATED(ahtu) ) THEN 967 963 CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point … … 993 989 CALL iom_rstput ( 0, 0, inum, "qz1_abl", tq_abl(:,:,2,nt_a,2) ) ! now first level humidity 994 990 ENDIF 995 991 ! 992 CALL iom_close( inum ) 993 ! 996 994 #if defined key_si3 997 995 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 996 CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 998 997 CALL ice_wri_state( inum ) 999 ENDIF 998 CALL iom_close( inum ) 999 ENDIF 1000 ! 1000 1001 #endif 1001 !1002 CALL iom_close( inum )1003 !1004 1002 END SUBROUTINE dia_wri_state 1005 1003 -
NEMO/branches/2020/r12581_ticket2418/src/OCE/FLO/floblk.F90
r12489 r12655 175 175 zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl)) 176 176 IF( zufl(jfl)*zuoutfl <= 0. ) THEN 177 ztxfl(jfl) = 1.E99177 ztxfl(jfl) = HUGE(1._wp) 178 178 ELSE 179 179 IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN … … 191 191 zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl)) 192 192 IF( zvfl(jfl)*zvoutfl <= 0. ) THEN 193 ztyfl(jfl) = 1.E99193 ztyfl(jfl) = HUGE(1._wp) 194 194 ELSE 195 195 IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN … … 208 208 zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl)) 209 209 IF( zwfl(jfl)*zwoutfl <= 0. ) THEN 210 ztzfl(jfl) = 1.E99210 ztzfl(jfl) = HUGE(1._wp) 211 211 ELSE 212 212 IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN -
NEMO/branches/2020/r12581_ticket2418/src/OCE/IOM/iom.F90
r12623 r12655 664 664 665 665 666 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev )666 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev, cdcomp ) 667 667 !!--------------------------------------------------------------------- 668 668 !! *** SUBROUTINE iom_open *** … … 677 677 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 678 678 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! number of vertical levels 679 CHARACTER(len=3), INTENT(in ), OPTIONAL :: cdcomp ! name of component calling iom_nf90_open 679 680 ! 680 681 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] … … 822 823 ENDIF 823 824 IF( istop == nstop ) THEN ! no error within this routine 824 CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev )825 CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev, cdcomp = cdcomp ) 825 826 ENDIF 826 827 ! -
NEMO/branches/2020/r12581_ticket2418/src/OCE/IOM/iom_def.F90
r12377 r12655 50 50 TYPE, PUBLIC :: file_descriptor 51 51 CHARACTER(LEN=240) :: name !: name of the file 52 CHARACTER(LEN=3 ) :: comp !: name of component opening the file ('OCE', 'ICE'...) 52 53 INTEGER :: nfid !: identifier of the file (0 if closed) 53 54 !: jpioipsl option has been removed) … … 64 65 REAL(kind=wp), DIMENSION(jpmax_vars) :: scf !: scale_factor of the variables 65 66 REAL(kind=wp), DIMENSION(jpmax_vars) :: ofs !: add_offset of the variables 66 INTEGER :: nlev ! number of vertical levels67 67 END TYPE file_descriptor 68 68 TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC :: iom_file !: array containing the info for all opened files -
NEMO/branches/2020/r12581_ticket2418/src/OCE/IOM/iom_nf90.F90
r12377 r12655 19 19 !!---------------------------------------------------------------------- 20 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce, ONLY: jpka,ght_abl ! abl vertical level number and height21 USE sbc_oce, ONLY: ght_abl ! abl vertical level number and height 22 22 USE lbclnk ! lateal boundary condition / mpp exchanges 23 23 USE iom_def ! iom variables definitions … … 46 46 CONTAINS 47 47 48 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev )48 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev, cdcomp ) 49 49 !!--------------------------------------------------------------------- 50 50 !! *** SUBROUTINE iom_open *** … … 58 58 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 59 59 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! size of the ice/abl third dimension 60 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cdcomp ! name of component calling iom_nf90_open 60 61 61 62 CHARACTER(LEN=256) :: clinfo ! info character 62 63 CHARACTER(LEN=256) :: cltmp ! temporary character 64 CHARACTER(LEN=3 ) :: clcomp ! name of component calling iom_nf90_open 63 65 INTEGER :: iln ! lengths of character 64 66 INTEGER :: istop ! temporary storage of nstop … … 70 72 INTEGER :: ihdf5 ! local variable for retrieval of value for NF90_HDF5 71 73 LOGICAL :: llclobber ! local definition of ln_clobber 72 INTEGER :: ilevels ! vertical levels73 74 !--------------------------------------------------------------------- 74 75 ! … … 77 78 ! 78 79 ! !number of vertical levels 79 IF( PRESENT(kdlev) ) THEN ; ilevels = kdlev ! use input value (useful for sea-ice and abl) 80 ELSE ; ilevels = jpk ! by default jpk 80 IF( PRESENT(cdcomp) ) THEN 81 IF( .NOT. PRESENT(kdlev) ) CALL ctl_stop( 'iom_nf90_open: cdcomp and kdlev must both be present' ) 82 clcomp = cdcomp ! use input value 83 ELSE 84 clcomp = 'OCE' ! by default 81 85 ENDIF 82 86 ! … … 125 129 CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo) 126 130 ! define dimensions 127 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1), idmy ), clinfo) 128 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1), idmy ), clinfo) 129 IF( PRESENT(kdlev) ) THEN 130 IF( kdlev == jpka ) THEN 131 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', kdlev, idmy ), clinfo) 132 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 133 ELSE 134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', kdlev, idmy ), clinfo) 137 ENDIF 138 ELSE 139 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 140 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 141 ENDIF 131 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1), idmy ), clinfo) 132 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1), idmy ), clinfo) 133 SELECT CASE (clcomp) 134 CASE ('OCE') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 135 CASE ('ICE') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', kdlev, idmy ), clinfo) 136 CASE ('ABL') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', kdlev, idmy ), clinfo) 137 CASE ('SED') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numsed', kdlev, idmy ), clinfo) 138 CASE DEFAULT ; CALL ctl_stop( 'iom_nf90_open unknown component type' ) 139 END SELECT 140 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 142 141 ! global attributes 143 142 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo) … … 165 164 ENDDO 166 165 iom_file(kiomid)%name = TRIM(cdname) 166 iom_file(kiomid)%comp = clcomp 167 167 iom_file(kiomid)%nfid = if90id 168 168 iom_file(kiomid)%nvars = 0 169 169 iom_file(kiomid)%irec = -1 ! useless for NetCDF files, used to know if the file is in define mode 170 iom_file(kiomid)%nlev = ilevels171 170 CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 172 171 IF( iom_file(kiomid)%iduld .GE. 0 ) THEN … … 529 528 INTEGER, DIMENSION(4) :: idimid ! dimensions id 530 529 CHARACTER(LEN=256) :: clinfo ! info character 531 CHARACTER(LEN= 12), DIMENSION(5) :: cltmp ! temporary character532 530 INTEGER :: if90id ! nf90 file identifier 533 INTEGER :: idmy ! dummy variable534 531 INTEGER :: itype ! variable type 535 532 INTEGER, DIMENSION(4) :: ichunksz ! NetCDF4 chunk sizes. Will be computed using … … 540 537 ! ! when appropriate (currently chunking is applied to 4d fields only) 541 538 INTEGER :: idlv ! local variable 542 INTEGER :: idim3 ! id of the third dimension543 539 !--------------------------------------------------------------------- 544 540 ! … … 554 550 ENDIF 555 551 ! define the dimension variables if it is not already done 556 ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 557 cltmp = (/ 'nav_lon ', 'nav_lat ', 'nav_lev ', 'time_counter', 'numcat ' /) 558 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 559 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) 560 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3 /), iom_file(kiomid)%nvid(3) ), clinfo) 561 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4 /), iom_file(kiomid)%nvid(4) ), clinfo) 552 DO jd = 1, 2 553 CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(jd,jd)),clinfo) 554 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ 1, 2 /), & 555 & iom_file(kiomid)%nvid(jd) ), clinfo) 556 END DO 557 iom_file(kiomid)%dimsz(2,1) = iom_file(kiomid)%dimsz(2,2) ! second dim of first variable 558 iom_file(kiomid)%dimsz(1,2) = iom_file(kiomid)%dimsz(1,1) ! first dim of second variable 559 DO jd = 3, 4 560 CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(1,jd)), clinfo) 561 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ jd /), & 562 & iom_file(kiomid)%nvid(jd) ), clinfo) 563 END DO 562 564 ! update informations structure related the dimension variable we just added... 563 565 iom_file(kiomid)%nvars = 4 564 566 iom_file(kiomid)%luld(1:4) = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 565 iom_file(kiomid)%cn_var(1:4) = cltmp(1:4)566 567 iom_file(kiomid)%ndims(1:4) = (/ 2, 2, 1, 1 /) 567 IF( NF90_INQ_DIMID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN ! add a 5th variable corresponding to the 5th dimension568 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(5)), NF90_FLOAT , (/ 5 /), iom_file(kiomid)%nvid(5) ), clinfo)569 iom_file(kiomid)%nvars = 5570 iom_file(kiomid)%luld(5) = .FALSE.571 iom_file(kiomid)%cn_var(5) = cltmp(5)572 iom_file(kiomid)%ndims(5) = 1573 ENDIF574 ! trick: defined to 0 to say that dimension variables are defined but not yet written575 iom_file(kiomid)%dimsz(1, 1) = 0576 568 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 577 569 ENDIF … … 594 586 IF( PRESENT(pv_r0d) ) THEN ; idims = 0 595 587 ELSEIF( PRESENT(pv_r1d) ) THEN 596 IF(( SIZE(pv_r1d,1) == jpk ).OR.( SIZE(pv_r1d,1) == jpka )) THEN ; idim3 = 3 597 ELSE ; idim3 = 5 598 ENDIF 599 idims = 2 ; idimid(1:idims) = (/idim3,4/) 600 ELSEIF( PRESENT(pv_r2d) ) THEN ; idims = 3 ; idimid(1:idims) = (/1,2 ,4/) 588 idims = 2 ; idimid(1:idims) = (/3,4/) 589 ELSEIF( PRESENT(pv_r2d) ) THEN ; idims = 3 ; idimid(1:idims) = (/1,2,4/) 601 590 ELSEIF( PRESENT(pv_r3d) ) THEN 602 IF(( SIZE(pv_r3d,3) == jpk ).OR.( SIZE(pv_r3d,3) == jpka )) THEN ; idim3 = 3 603 ELSE ; idim3 = 5 604 ENDIF 605 idims = 4 ; idimid(1:idims) = (/1,2,idim3,4/) 591 idims = 4 ; idimid(1:idims) = (/1,2,3,4/) 606 592 ENDIF 607 593 IF( PRESENT(ktype) ) THEN ! variable external type … … 678 664 ! ============= 679 665 ! trick: is defined to 0 => dimension variable are defined but not yet written 680 IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 681 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon' , idmy ) , clinfo ) 682 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 683 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat' , idmy ) , clinfo ) 684 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 685 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev' , idmy ), clinfo ) 686 IF (iom_file(kiomid)%nlev == jpka) THEN ; CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, ght_abl), clinfo ) 687 ELSE ; CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gdept_1d), clinfo ) 688 ENDIF 689 IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN 690 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) 691 ENDIF 692 ! +++ WRONG VALUE: to be improved but not really useful... 693 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo ) 694 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt ), clinfo ) 695 ! update the values of the variables dimensions size 696 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo ) 697 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo ) 698 iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 699 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo ) 700 iom_file(kiomid)%dimsz(1 , 4) = 1 ! unlimited dimension 666 IF( iom_file(kiomid)%dimsz(1, 4) == 0 ) THEN ! time_counter = 0 667 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 1, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 668 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 2, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 669 SELECT CASE (iom_file(kiomid)%comp) 670 CASE ('OCE') 671 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, gdept_1d ), clinfo ) 672 CASE ('ABL') 673 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, ght_abl ), clinfo ) 674 CASE DEFAULT 675 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, (/ (idlv, idlv = 1,iom_file(kiomid)%dimsz(1,3)) /) ), clinfo ) 676 END SELECT 677 ! "wrong" value: to be improved but not really useful... 678 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 4, kt ), clinfo ) 679 ! update the size of the variable corresponding to the unlimited dimension 680 iom_file(kiomid)%dimsz(1, 4) = 1 ! so we don't enter this IF case any more... 701 681 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 702 682 ENDIF -
NEMO/branches/2020/r12581_ticket2418/src/OCE/SBC/sbcblk.F90
r12623 r12655 1036 1036 evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_rLsub ! sublimation 1037 1037 devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_rLsub ! d(sublimation)/dT 1038 zevap (:,:) = rn_efac * ( emp(:,:) + tprecip(:,:) ) ! evaporation over ocean !LB: should we remove rn_efac here???1038 zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean !LB: removed rn_efac here, correct??? 1039 1039 1040 1040 ! --- evaporation minus precipitation --- ! -
NEMO/branches/2020/r12581_ticket2418/src/OCE/STO/storng.F90
r12377 r12655 50 50 51 51 ! Parameters to generate real random variates 52 REAL(KIND=wp), PARAMETER :: huge64=9223372036854775808.0 ! +153 52 REAL(KIND=wp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0 54 53 … … 275 274 REAL(KIND=wp) :: uran 276 275 277 uran = half * ( one + REAL(kiss(),wp) / huge64)276 uran = half * ( one + REAL(kiss(),wp) / HUGE(1._wp) ) 278 277 279 278 END SUBROUTINE kiss_uniform … … 298 297 rsq = two 299 298 DO WHILE ( (rsq.GE.one).OR. (rsq.EQ.zero) ) 300 u1 = REAL(kiss(),wp) / huge64301 u2 = REAL(kiss(),wp) / huge64299 u1 = REAL(kiss(),wp) / HUGE(1._wp) 300 u2 = REAL(kiss(),wp) / HUGE(1._wp) 302 301 rsq = u1*u1 + u2*u2 303 302 ENDDO -
NEMO/branches/2020/r12581_ticket2418/src/OCE/nemogcm.F90
r12593 r12655 84 84 #endif 85 85 ! 86 USE in_out_manager ! I/O manager 86 87 USE lib_mpp ! distributed memory computing 87 88 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 317 318 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 318 319 ! open /dev/null file to be able to supress output write easily 320 IF( Agrif_Root() ) THEN 319 321 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 320 ! 322 #ifdef key_agrif 323 ELSE 324 numnul = Agrif_Parent(numnul) 325 #endif 326 ENDIF 321 327 ! !--------------------! 322 328 ! ! Open listing units ! -> need sn_cfctl from namctl to define lwp -
NEMO/branches/2020/r12581_ticket2418/src/OCE/step.F90
r12593 r12655 86 86 !! --------------------------------------------------------------------- 87 87 #if defined key_agrif 88 IF( nstop > 0 ) return ! avoid to go further if an error was detected during previous time step 88 89 kstp = nit000 + Agrif_Nb_Step() 89 90 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices … … 306 307 #if defined key_agrif 307 308 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 308 ! AGRIF 309 ! AGRIF recursive integration 309 310 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 310 311 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 311 312 CALL Agrif_Integrate_ChildGrids( stp ) ! allows to finish all the Child Grids before updating 312 313 313 IF( Agrif_NbStepint() == 0 ) THEN 314 CALL Agrif_update_all( ) ! Update all components 315 ENDIF 314 #endif 315 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 316 ! Control 317 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 318 CALL stp_ctl ( kstp, Nnn ) 319 320 #if defined key_agrif 321 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 322 ! AGRIF update 323 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 324 IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN 325 CALL Agrif_update_all( ) ! Update all components 326 ENDIF 327 316 328 #endif 317 329 IF( ln_diaobs ) CALL dia_obs ( kstp, Nnn ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 318 330 319 331 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 320 ! Control 321 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 322 CALL stp_ctl ( kstp, Nnn ) 323 332 ! File manipulation at the end of the first time step 333 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 324 334 IF( kstp == nit000 ) THEN ! 1st time step only 325 335 CALL iom_close( numror ) ! close input ocean restart file … … 335 345 ! 336 346 #if defined key_iomput 347 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 348 ! Finalize contextes if end of simulation or error detected 349 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 337 350 IF( kstp == nitend .OR. nstop > 0 ) THEN 338 351 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 339 352 IF( lrxios ) CALL iom_context_finalize( crxios_context ) 340 IF( ln_crs ) CALL iom_context_finalize( TRIM(cxios_context)//"_crs" ) !353 IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 341 354 ENDIF 342 355 #endif -
NEMO/branches/2020/r12581_ticket2418/src/OFF/nemogcm.F90
r12593 r12655 209 209 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 210 210 ! open /dev/null file to be able to supress output write easily 211 IF( Agrif_Root() ) THEN 211 212 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 213 #ifdef key_agrif 214 ELSE 215 numnul = Agrif_Parent(numnul) 216 #endif 217 ENDIF 212 218 ! 213 219 ! !--------------------! -
NEMO/branches/2020/r12581_ticket2418/src/SAO/nemogcm.F90
r12593 r12655 29 29 USE sao_intp 30 30 ! 31 USE in_out_manager ! I/O manager 31 32 USE lib_mpp ! distributed memory computing 32 33 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 139 140 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 140 141 ! open /dev/null file to be able to supress output write easily 142 IF( Agrif_Root() ) THEN 141 143 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 144 #ifdef key_agrif 145 ELSE 146 numnul = Agrif_Parent(numnul) 147 #endif 148 ENDIF 142 149 ! 143 150 ! !--------------------! -
NEMO/branches/2020/r12581_ticket2418/src/SAS/diawri.F90
r12593 r12655 138 138 !! Each nn_write time step, output the instantaneous or mean fields 139 139 !!---------------------------------------------------------------------- 140 !!141 140 INTEGER, INTENT( in ) :: kt ! ocean time-step index 142 INTEGER, INTENT( in ) :: Kmm ! ocean time level index141 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 143 142 !! 144 143 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout … … 258 257 IF( ln_abl ) THEN 259 258 ! Define the ABL grid FILE ( nid_A ) 260 CALL dia_nam( clhstnam, n write, 'grid_ABL' )259 CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 261 260 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename 262 261 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit … … 438 437 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 439 438 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 440 441 #if defined key_si3 442 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 443 #else 444 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 445 #endif 446 439 ! 440 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 441 ! 447 442 CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) ) ! now temperature 448 443 CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) ) ! now salinity … … 457 452 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 458 453 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 459 454 ! 455 CALL iom_close( inum ) 456 ! 460 457 #if defined key_si3 461 458 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 459 CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 462 460 CALL ice_wri_state( inum ) 463 ENDIF 464 #endif 465 ! 466 CALL iom_close( inum ) 467 ! 461 CALL iom_close( inum ) 462 ENDIF 463 ! 464 #endif 468 465 END SUBROUTINE dia_wri_state 469 466 -
NEMO/branches/2020/r12581_ticket2418/src/SAS/nemogcm.F90
r12593 r12655 35 35 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 36 36 ! 37 USE in_out_manager ! I/O manager 37 38 USE lib_mpp ! distributed memory computing 38 39 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 256 257 ENDIF 257 258 ! open /dev/null file to be able to supress output write easily 259 IF( Agrif_Root() ) THEN 258 260 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 261 #ifdef key_agrif 262 ELSE 263 numnul = Agrif_Parent(numnul) 264 #endif 265 ENDIF 259 266 ! 260 267 ! !--------------------! -
NEMO/branches/2020/r12581_ticket2418/src/SAS/step.F90
r12593 r12655 76 76 77 77 #if defined key_agrif 78 IF( nstop > 0 ) return ! avoid to go further if an error was detected during previous time step 78 79 kstp = nit000 + Agrif_Nb_Step() 79 80 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices … … 103 104 #if defined key_agrif 104 105 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 105 ! AGRIF 106 ! AGRIF recursive integration 106 107 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 107 CALL Agrif_Integrate_ChildGrids( stp ) 108 CALL Agrif_Integrate_ChildGrids( stp ) 109 110 #endif 111 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 112 ! Control 113 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 114 CALL stp_ctl( kstp, Nnn ) 108 115 109 IF( Agrif_NbStepint() == 0 ) THEN ! AGRIF Update from zoom N to zoom 1 then to Parent 116 #if defined key_agrif 117 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 118 ! AGRIF update 119 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 120 IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN ! AGRIF Update from zoom N to zoom 1 then to Parent 110 121 #if defined key_si3 111 122 CALL Agrif_Update_ice( ) ! update sea-ice 112 123 #endif 113 124 ENDIF 125 114 126 #endif 115 116 127 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 117 ! Control 118 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 119 CALL stp_ctl( kstp, Nnn ) 120 121 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 128 ! File manipulation at the end of the first time step 129 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 130 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 122 131 123 132 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
NEMO/branches/2020/r12581_ticket2418/src/SAS/stpctl.F90
r12593 r12655 119 119 zmaxlocal(:) = zmax(:) 120 120 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 121 nstop = NINT( zmax( 9) ) ! update nstop indicator (now sheared among all local domains)121 nstop = NINT( zmax(4) ) ! update nstop indicator (now sheared among all local domains) 122 122 ENDIF 123 123 ! !== write "run.stat" files ==! -
NEMO/branches/2020/r12581_ticket2418/src/TOP/PISCES/SED/sedrst.F90
r12489 r12655 80 80 IF(lwp) WRITE(numsed,*) & 81 81 ' open sed restart.output NetCDF file: ',TRIM(clpath)//clname 82 CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed )82 CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' ) 83 83 lrst_sed = .TRUE. 84 84 ENDIF -
NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/EXPREF/plot_station_asf.py
r12031 r12655 53 53 L_VARL = [ r'$Q_{lat}$', r'$Q_{sens}$' , r'$Q_{net}$' , r'$Q_{lw}$' , r'$|\tau|$' , r'$\Delta T_{skin}$' ] ; # name of variable in latex mode 54 54 L_VUNT = [ r'$W/m^2$' , r'$W/m^2$' , r'$W/m^2$' , r'$W/m^2$' , r'$N/m^2$' , 'K' ] 55 L_VMAX = [ 75. , 75. , 800. , 25. , 1.2 , -0.7 ]56 L_VMIN = [ -250. , -125. , -400. , -150. , 0. , 55 L_VMAX = [ 75. , 75. , 800. , 25. , 1.2 , 0.7 ] 56 L_VMIN = [ -250. , -125. , -400. , -150. , 0. , -0.7 ] 57 57 L_ANOM = [ True , True , True , True , True , False ] 58 58 -
NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC/nemogcm.F90
r12623 r12655 30 30 USE step_c1d ! Time stepping loop for the 1D configuration 31 31 ! 32 USE in_out_manager ! I/O manager 32 33 USE lib_mpp ! distributed memory computing 33 34 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 165 166 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 166 167 ! open /dev/null file to be able to supress output write easily 168 IF( Agrif_Root() ) THEN 167 169 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 170 #ifdef key_agrif 171 ELSE 172 numnul = Agrif_Parent(numnul) 173 #endif 174 ENDIF 168 175 ! 169 176 ! !--------------------! -
NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC/sbcssm.F90
r12623 r12655 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/SAS 4.0 , NEMO Consortium (2018) 56 !! $Id: sbcssm.F90 12 377 2020-02-12 14:39:06Z acc$56 !! $Id: sbcssm.F90 12615 2020-03-26 15:18:49Z laurent $ 57 57 !! Software governed by the CeCILL license (see ./LICENSE) 58 58 !!---------------------------------------------------------------------- -
NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC/step_c1d.F90
r12623 r12655 64 64 CALL sbc ( kstp, Nbb, Nnn ) ! Sea Boundary Condition (including sea-ice) 65 65 66 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 67 ! diagnostics and outputs 68 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 66 69 CALL dia_wri( kstp, Nnn ) ! ocean model: outputs 67 70 -
NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
r11930 r12655 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp, njmpp 16 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain 17 17 USE c1d , ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist 18 18 USE par_oce ! ocean space and time domain … … 30 30 !!---------------------------------------------------------------------- 31 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 32 !! $Id: usrdef_hgr.F90 1 0072 2018-08-28 15:21:50Z nicolasmartin $32 !! $Id: usrdef_hgr.F90 12489 2020-02-28 15:55:11Z davestorkey $ 33 33 !! Software governed by the CeCILL license (see ./LICENSE) 34 34 !!---------------------------------------------------------------------- … … 54 54 !! 55 55 !! ** Action : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 56 !! - define coriolis parameter at f-point if the domain in not on the sphere 56 !! - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane) 57 57 !! - define i- & j-scale factors at t-, u-, v- and f-points (in meters) 58 58 !! - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2) -
NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
r12249 r12655 8 8 !!====================================================================== 9 9 !! History : 4.0 ! 2016-03 (S. Flavoni, G. Madec) Original code 10 !! History :4.x ! 2019-10 (L. Brodeau) for STATION_ASF (C1D meets SAS)10 !! 4.x ! 2019-10 (L. Brodeau) for STATION_ASF (C1D meets SAS) 11 11 !!---------------------------------------------------------------------- 12 12 … … 15 15 !! usr_def_hgr : initialize the horizontal mesh 16 16 !!---------------------------------------------------------------------- 17 USE dom_oce , ONLY: nimpp, njmpp 18 USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate17 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain 18 !!! USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate 19 19 USE par_oce ! ocean space and time domain 20 20 USE phycst ! physical constants … … 33 33 !!---------------------------------------------------------------------- 34 34 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 35 !! $Id: usrdef_nam.F90 1 1536 2019-09-11 13:54:18Z smasson$35 !! $Id: usrdef_nam.F90 12377 2020-02-12 14:39:06Z acc $ 36 36 !! Software governed by the CeCILL license (see ./LICENSE) 37 37 !!---------------------------------------------------------------------- … … 68 68 kk_cfg = 0 69 69 70 ! Global Domain size: STATION_ASF domain is 3 x 3 grid-points x 75or vertical levels70 ! Global Domain size: STATION_ASF domain is 3 x 3 grid-points x 2 or vertical levels 71 71 kpi = 3 72 72 kpj = 3 73 kpk = 173 kpk = 2 ! 2, rather than 1, because 1 would cause some issues... like overflow in array boundary indexes, etc... 74 74 ! 75 75 ! ! Set the lateral boundary condition of the global domain -
NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90
r12038 r12655 1 1 MODULE usrdef_zgr 2 2 !!====================================================================== 3 !! *** MODULEusrdef_zgr ***3 !! *** MODULE usrdef_zgr *** 4 4 !! 5 5 !! === STATION_ASF case === 6 6 !! 7 !! user defined :vertical coordinate system of a user configuration7 !! User defined : vertical coordinate system of a user configuration 8 8 !!====================================================================== 9 !! History : 4.0 ! 2019-10 (L. Brodeau) Original code 9 !! History : 4.0 ! 2016-06 (G. Madec) Original code 10 !! 4.x ! 2019-10 (L. Brodeau) Station ASF 10 11 !!---------------------------------------------------------------------- 11 12 12 13 !!---------------------------------------------------------------------- 13 !! usr_def_zgr : user defined vertical coordinate system (required) 14 !! usr_def_zgr : user defined vertical coordinate system 15 !! zgr_z : reference 1D z-coordinate 16 !! zgr_top_bot: ocean top and bottom level indices 17 !! zgr_zco : 3D verticl coordinate in pure z-coordinate case 14 18 !!--------------------------------------------------------------------- 15 19 USE oce ! ocean variables 16 !USE dom_oce ! ocean domain17 !USE depth_e3 ! depth <=> e318 20 USE usrdef_nam ! User defined : namelist variables 19 21 ! … … 21 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 24 USE lib_mpp ! distributed memory computing library 23 USE timing ! Timing24 25 25 26 IMPLICIT NONE 26 27 PRIVATE 27 28 28 PUBLIC usr_def_zgr ! called by domzgr.F9029 PUBLIC usr_def_zgr ! called by domzgr.F90 29 30 30 31 !!---------------------------------------------------------------------- 31 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 32 !! $Id: usrdef_zgr.F90 1 0072 2018-08-28 15:21:50Z nicolasmartin$33 !! $Id: usrdef_zgr.F90 12377 2020-02-12 14:39:06Z acc $ 33 34 !! Software governed by the CeCILL license (see ./LICENSE) 34 35 !!---------------------------------------------------------------------- … … 47 48 !! 48 49 !!---------------------------------------------------------------------- 49 LOGICAL , INTENT( out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags ( read in namusr_def )50 LOGICAL , INTENT( 51 REAL(wp), DIMENSION(:) , INTENT( 52 REAL(wp), DIMENSION(:) , INTENT( 53 REAL(wp), DIMENSION(:,:,:), INTENT( 54 REAL(wp), DIMENSION(:,:,:), INTENT( 55 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! i-scale factors56 INTEGER , DIMENSION(:,:) , INTENT( 50 LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags 51 LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag 52 REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m] 53 REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m] 54 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m] 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 57 INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level 57 58 !!---------------------------------------------------------------------- 58 59 ! … … 61 62 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 62 63 ! 63 64 ! 65 ! type of vertical coordinate 66 ! --------------------------- 64 67 ld_zco = .TRUE. ! z-coordinate without ocean cavities 65 68 ld_zps = .FALSE. 66 69 ld_sco = .FALSE. 67 70 ld_isfcav = .FALSE. 68 71 72 !! 1st level (the only one that matters) 69 73 pdept_1d(1) = rn_dept1 ! depth (m) at which the SST is taken/measured == depth of first T point! 70 74 pdepw_1d(1) = 0._wp … … 72 76 pe3w_1d(1) = rn_dept1 ! LB??? 73 77 74 pdept(:,:,:) = rn_dept1 75 pdepw(:,:,:) = 0._wp 76 pe3t(:,:,:) = 2._wp*rn_dept1 77 pe3u(:,:,:) = 2._wp*rn_dept1 78 pe3v(:,:,:) = 2._wp*rn_dept1 79 pe3f(:,:,:) = 2._wp*rn_dept1 80 pe3w(:,:,:) = rn_dept1 ! LB??? 81 pe3uw(:,:,:) = rn_dept1 ! LB??? 82 pe3vw(:,:,:) = rn_dept1 ! LB??? 78 pdept(:,:,1) = rn_dept1 79 pdepw(:,:,1) = 0._wp 80 pe3t(:,:,1) = 2._wp*rn_dept1 81 pe3u(:,:,1) = 2._wp*rn_dept1 82 pe3v(:,:,1) = 2._wp*rn_dept1 83 pe3f(:,:,1) = 2._wp*rn_dept1 84 pe3w(:,:,1) = rn_dept1 ! LB??? 85 pe3uw(:,:,1) = rn_dept1 ! LB??? 86 pe3vw(:,:,1) = rn_dept1 ! LB??? 87 88 !! 2nd level, technically useless (only for the sake of code stability) 89 pdept_1d(2) = 3._wp*rn_dept1 90 pdepw_1d(2) = 2._wp*rn_dept1 91 pe3t_1d(2) = 2._wp*rn_dept1 92 pe3w_1d(2) = 2._wp*rn_dept1 93 94 pdept(:,:,2) = 3._wp*rn_dept1 95 pdepw(:,:,2) = 2._wp*rn_dept1 96 pe3t(:,:,2) = 2._wp*rn_dept1 97 pe3u(:,:,2) = 2._wp*rn_dept1 98 pe3v(:,:,2) = 2._wp*rn_dept1 99 pe3f(:,:,2) = 2._wp*rn_dept1 100 pe3w(:,:,2) = 2._wp*rn_dept1 101 pe3uw(:,:,2) = 2._wp*rn_dept1 102 pe3vw(:,:,2) = 2._wp*rn_dept1 103 83 104 k_top = 1 84 105 k_bot = 1 85 ! 106 86 107 END SUBROUTINE usr_def_zgr 87 108 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.