Changeset 6204 for branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2016-01-04T14:47:06+01:00 (8 years ago)
- Location:
- branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 28 edited
-
BDY/bdyice_lim.F90 (modified) (1 diff)
-
BDY/bdyini.F90 (modified) (9 diffs)
-
DIA/diawri.F90 (modified) (2 diffs)
-
DOM/domhgr.F90 (modified) (1 diff)
-
DOM/domzgr.F90 (modified) (3 diffs)
-
DYN/divcur.F90 (modified) (2 diffs)
-
DYN/dynspg_ts.F90 (modified) (2 diffs)
-
DYN/sshwzv.F90 (modified) (2 diffs)
-
IOM/iom.F90 (modified) (24 diffs)
-
LBC/lib_mpp.F90 (modified) (1 diff)
-
SBC/fldread.F90 (modified) (2 diffs)
-
SBC/sbccpl.F90 (modified) (4 diffs)
-
SBC/sbcisf.F90 (modified) (1 diff)
-
SBC/sbcrnf.F90 (modified) (1 diff)
-
TRA/traadv_eiv.F90 (modified) (1 diff)
-
TRA/traadv_tvd.F90 (modified) (2 diffs)
-
TRA/tranxt.F90 (modified) (4 diffs)
-
TRD/trdken.F90 (modified) (3 diffs)
-
TRD/trdmxl.F90 (modified) (3 diffs)
-
TRD/trdpen.F90 (modified) (1 diff)
-
ZDF/zdf_oce.F90 (modified) (2 diffs)
-
ZDF/zdfgls.F90 (modified) (2 diffs)
-
ZDF/zdfmxl.F90 (modified) (1 diff)
-
ZDF/zdftke.F90 (modified) (7 diffs)
-
nemogcm.F90 (modified) (4 diffs)
-
step.F90 (modified) (13 diffs)
-
step_oce.F90 (modified) (1 diff)
-
stpctl.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
r5887 r6204 107 107 REAL(wp) :: zwgt, zwgt1 ! local scalar 108 108 REAL(wp) :: ztmelts, zdh 109 #if defined key_lim2 && ! defined key_lim2_vp && defined key_agrif 110 USE ice_2, vt_s => hsnm 111 USE ice_2, vt_i => hicm 112 #endif 109 113 110 114 !!------------------------------------------------------------------------------ -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r4990 r6204 76 76 INTEGER :: ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 77 77 INTEGER :: icount, icountr, ibr_max, ilen1, ibm1 ! local integers 78 INTEGER :: iw , ie, is, in, inum, id_dummy ! - -78 INTEGER :: iwe, ies, iso, ino, inum, id_dummy ! - - 79 79 INTEGER :: igrd_start, igrd_end, jpbdta ! - - 80 80 INTEGER :: jpbdtau, jpbdtas ! - - … … 777 777 ! is = mjg(1) + 1 ! if monotasking and no zoom, is=2 778 778 ! in = mjg(1) + nlcj-1 - 1 ! if monotasking and no zoom, in=jpjm1 779 iw = mig(1) - jpizoom + 2 ! if monotasking and no zoom, iw=2780 ie = mig(1) + nlci - jpizoom - 1 ! if monotasking and no zoom, ie=jpim1781 is = mjg(1) - jpjzoom + 2 ! if monotasking and no zoom, is=2782 in = mjg(1) + nlcj - jpjzoom - 1 ! if monotasking and no zoom, in=jpjm1779 iwe = mig(1) - jpizoom + 2 ! if monotasking and no zoom, iw=2 780 ies = mig(1) + nlci - jpizoom - 1 ! if monotasking and no zoom, ie=jpim1 781 iso = mjg(1) - jpjzoom + 2 ! if monotasking and no zoom, is=2 782 ino = mjg(1) + nlcj - jpjzoom - 1 ! if monotasking and no zoom, in=jpjm1 783 783 784 784 ALLOCATE( nbondi_bdy(nb_bdy)) … … 853 853 ENDIF 854 854 ! check if point is in local domain 855 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie.AND. &856 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in) THEN855 IF( nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND. & 856 & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino ) THEN 857 857 ! 858 858 icount = icount + 1 … … 890 890 com_south_b = 0 891 891 com_north_b = 0 892 892 893 DO igrd = 1, jpbgrd 893 894 icount = 0 … … 896 897 DO ib = 1, nblendta(igrd,ib_bdy) 897 898 ! check if point is in local domain and equals ir 898 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie.AND. &899 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in.AND. &899 IF( nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND. & 900 & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND. & 900 901 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 901 902 ! … … 1594 1595 ELSE 1595 1596 ! This is a corner 1596 WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)1597 IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib) 1597 1598 CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1)) 1598 1599 itest=itest+1 … … 1608 1609 ELSE 1609 1610 ! This is a corner 1610 WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)1611 IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib) 1611 1612 CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2)) 1612 1613 itest=itest+1 … … 1638 1639 ELSE 1639 1640 ! This is a corner 1640 WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)1641 IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib) 1641 1642 CALL bdy_ctl_corn(npckge(ib), icorne(ib,1)) 1642 1643 itest=itest+1 … … 1652 1653 ELSE 1653 1654 ! This is a corner 1654 WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)1655 IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib) 1655 1656 CALL bdy_ctl_corn(npckge(ib), icorne(ib,2)) 1656 1657 itest=itest+1 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5565 r6204 1018 1018 CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth 1019 1019 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1020 CALL histdef( id_i, "vovvle3t", "T point thickness" , "m" , & ! t-point depth 1021 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1020 1022 END IF 1021 1023 … … 1048 1050 CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress 1049 1051 CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress 1052 IF( lk_vvl ) THEN 1053 CALL histwrite( id_i, "vovvldep", kt, fsdept_n(:,:,:), jpi*jpj*jpk, idex )! T-cell depth 1054 CALL histwrite( id_i, "vovvle3t", kt, fse3t_n (:,:,:), jpi*jpj*jpk, idex )! T-cell thickness 1055 END IF 1050 1056 1051 1057 ! 3. Close the file -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r5551 r6204 544 544 IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only 545 545 IF( .NOT. Agrif_Root() ) THEN 546 zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 546 zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) & 547 & / (ra * rad) 547 548 ENDIF 548 549 ENDIF -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r6036 r6204 219 219 & ppsur == pp_to_be_computed ) THEN 220 220 ! 221 #if defined key_agrif 222 za1 = ( ppdzmin - pphmax / FLOAT(jpkdta-1) ) & 223 & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpkdta-1) * ( LOG( COSH( (jpkdta - ppkth) / ppacr) )& 224 & - LOG( COSH( ( 1 - ppkth) / ppacr) ) ) ) 225 #else 221 226 za1 = ( ppdzmin - pphmax / FLOAT(jpkm1) ) & 222 227 & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * ( LOG( COSH( (jpk - ppkth) / ppacr) ) & 223 228 & - LOG( COSH( ( 1 - ppkth) / ppacr) ) ) ) 229 #endif 224 230 za0 = ppdzmin - za1 * TANH( (1-ppkth) / ppacr ) 225 231 zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr ) ) … … 236 242 WRITE(numout,*) ' Uniform grid with ',jpk-1,' layers' 237 243 WRITE(numout,*) ' Total depth :', zhmax 244 #if defined key_agrif 245 WRITE(numout,*) ' Layer thickness:', zhmax/(jpkdta-1) 246 #else 238 247 WRITE(numout,*) ' Layer thickness:', zhmax/(jpk-1) 248 #endif 239 249 ELSE 240 250 IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN … … 260 270 ! Reference z-coordinate (depth - scale factor at T- and W-points) 261 271 ! ====================== 262 IF( ppkth == 0._wp ) THEN ! uniform vertical grid 272 IF( ppkth == 0._wp ) THEN ! uniform vertical grid 273 #if defined key_agrif 274 za1 = zhmax / FLOAT(jpkdta-1) 275 #else 263 276 za1 = zhmax / FLOAT(jpk-1) 277 #endif 264 278 DO jk = 1, jpk 265 279 zw = FLOAT( jk ) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r5516 r6204 97 97 IF( nn_timing == 1 ) CALL timing_start('div_cur') 98 98 ! 99 CALL wrk_alloc( jpi , jpj+2, zwu 100 CALL wrk_alloc( jpi+ 4, jpj , zwv, kistart = -1)99 CALL wrk_alloc( jpi , jpj+2, zwu ) 100 CALL wrk_alloc( jpi+2, jpj , zwv ) 101 101 ! 102 102 IF( kt == nit000 ) THEN … … 236 236 CALL lbc_lnk( hdivn, 'T', 1. ) ; CALL lbc_lnk( rotn , 'F', 1. ) ! lateral boundary cond. (no sign change) 237 237 ! 238 CALL wrk_dealloc( jpi , jpj+2, zwu 239 CALL wrk_dealloc( jpi+ 4, jpj , zwv, kistart = -1)238 CALL wrk_dealloc( jpi , jpj+2, zwu ) 239 CALL wrk_dealloc( jpi+2, jpj , zwv ) 240 240 ! 241 241 IF( nn_timing == 1 ) CALL timing_stop('div_cur') -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5912 r6204 465 465 ENDIF 466 466 #endif 467 ! !* Fill boundary data arrays withAGRIF468 ! ! ------------------------------------ -467 ! !* Fill boundary data arrays for AGRIF 468 ! ! ------------------------------------ 469 469 #if defined key_agrif 470 470 IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt ) … … 900 900 #if defined key_agrif 901 901 ! Save time integrated fluxes during child grid integration 902 ! (used to update coarse grid transports) 903 ! Useless with 2nd order momentum schemes 902 ! (used to update coarse grid transports at next time step) 904 903 ! 905 904 IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r5628 r6204 31 31 USE bdydyn2d ! bdy_ssh routine 32 32 #if defined key_agrif 33 USE agrif_opa_update34 33 USE agrif_opa_interp 35 34 #endif … … 274 273 ENDIF 275 274 ! 276 ! Update velocity at AGRIF zoom boundaries277 #if defined key_agrif278 IF ( .NOT.Agrif_Root() ) CALL Agrif_Update_Dyn( kt )279 #endif280 !281 275 IF(ln_ctl) CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb - : ', mask1=tmask, ovlap=1 ) 282 276 ! -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5426 r6204 94 94 CHARACTER(len=*), INTENT(in) :: cdname 95 95 #if defined key_iomput 96 TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0) 97 CHARACTER(len=19) :: cldate 98 CHARACTER(len=10) :: clname 99 INTEGER :: ji 96 #if ! defined key_xios2 97 TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0) 98 CHARACTER(len=19) :: cldate 99 #else 100 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 101 TYPE(xios_date) :: start_date 102 #endif 103 CHARACTER(len=10) :: clname 104 INTEGER :: ji 100 105 ! 101 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 102 107 !!---------------------------------------------------------------------- 103 108 #if ! defined key_xios2 104 109 ALLOCATE( z_bnds(jpk,2) ) 110 #else 111 ALLOCATE( z_bnds(2,jpk) ) 112 #endif 105 113 106 114 clname = cdname … … 110 118 111 119 ! calendar parameters 120 #if ! defined key_xios2 112 121 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 113 122 CASE ( 1) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian") … … 117 126 WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday 118 127 CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 119 128 #else 129 ! Calendar type is now defined in xml file 130 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 131 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), & 132 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 133 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(1900,01,01,00,00,00), & 134 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 135 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(1900,01,01,00,00,00), & 136 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 137 END SELECT 138 #endif 120 139 ! horizontal grid definition 140 141 #if ! defined key_xios2 121 142 CALL set_scalar 143 #endif 122 144 123 145 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN … … 170 192 171 193 ! Add vertical grid bounds 194 #if ! defined key_xios2 172 195 z_bnds(: ,1) = gdepw_1d(:) 173 196 z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 174 197 z_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 198 #else 199 z_bnds(1 ,:) = gdepw_1d(:) 200 z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 201 z_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 202 #endif 203 175 204 CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 176 205 CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 177 206 CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 178 z_bnds(: ,2) = gdept_1d(:) 179 z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 180 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1) 207 208 #if ! defined key_xios2 209 z_bnds(: ,2) = gdept_1d(:) 210 z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 211 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1) 212 #else 213 z_bnds(2,: ) = gdept_1d(:) 214 z_bnds(1,2:jpk) = gdept_1d(1:jpkm1) 215 z_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 216 #endif 181 217 CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 218 182 219 183 220 # if defined key_floats … … 1158 1195 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1159 1196 1197 #if ! defined key_xios2 1160 1198 IF ( xios_is_valid_domain (cdid) ) THEN 1161 1199 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1164 1202 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1165 1203 & bounds_lat=bounds_lat, area=area ) 1166 ENDIF 1167 1204 ENDIF 1168 1205 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1169 1206 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1173 1210 & bounds_lat=bounds_lat, area=area ) 1174 1211 ENDIF 1212 1213 #else 1214 IF ( xios_is_valid_domain (cdid) ) THEN 1215 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1216 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1217 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1218 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1219 ENDIF 1220 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1221 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1222 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1223 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1224 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 1225 ENDIF 1226 #endif 1175 1227 CALL xios_solve_inheritance() 1176 1228 1177 1229 END SUBROUTINE iom_set_domain_attr 1230 1231 #if defined key_xios2 1232 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 1233 CHARACTER(LEN=*) , INTENT(in) :: cdid 1234 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1235 1236 IF ( xios_is_valid_domain (cdid) ) THEN 1237 CALL xios_set_zoom_domain_attr ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, & 1238 & nj=nj) 1239 ENDIF 1240 END SUBROUTINE iom_set_zoom_domain_attr 1241 #endif 1178 1242 1179 1243 … … 1183 1247 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1184 1248 IF ( PRESENT(paxis) ) THEN 1249 #if ! defined key_xios2 1185 1250 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis ) 1186 1251 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 1252 #else 1253 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1254 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1255 #endif 1187 1256 ENDIF 1188 1257 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) … … 1191 1260 END SUBROUTINE iom_set_axis_attr 1192 1261 1193 1194 1262 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1195 1263 CHARACTER(LEN=*) , INTENT(in) :: cdid 1196 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1197 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1198 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1199 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1264 #if ! defined key_xios2 1265 CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_op 1266 CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_offset 1267 #else 1268 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_op 1269 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_offset 1270 #endif 1271 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1272 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1273 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr & 1274 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1200 1275 CALL xios_solve_inheritance() 1201 1276 END SUBROUTINE iom_set_field_attr 1202 1203 1277 1204 1278 SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) … … 1213 1287 SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 1214 1288 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1215 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix, output_freq 1289 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix 1290 #if ! defined key_xios2 1291 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: output_freq 1292 #else 1293 TYPE(xios_duration) ,OPTIONAL , INTENT(out) :: output_freq 1294 #endif 1216 1295 LOGICAL :: llexist1,llexist2,llexist3 1217 1296 !--------------------------------------------------------------------- 1218 1297 IF( PRESENT( name ) ) name = '' ! default values 1219 1298 IF( PRESENT( name_suffix ) ) name_suffix = '' 1299 #if ! defined key_xios2 1220 1300 IF( PRESENT( output_freq ) ) output_freq = '' 1301 #else 1302 IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0) 1303 #endif 1221 1304 IF ( xios_is_valid_file (cdid) ) THEN 1222 1305 CALL xios_solve_inheritance() … … 1239 1322 CHARACTER(LEN=*) , INTENT(in) :: cdid 1240 1323 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1324 #if ! defined key_xios2 1241 1325 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask ) 1242 1326 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask ) 1327 #else 1328 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask3=mask ) 1329 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask3=mask ) 1330 #endif 1243 1331 CALL xios_solve_inheritance() 1244 1332 END SUBROUTINE iom_set_grid_attr … … 1282 1370 ni=nlei-nldi+1 ; nj=nlej-nldj+1 1283 1371 1284 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1372 #if ! defined key_xios2 1373 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1374 #else 1375 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1376 #endif 1285 1377 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1286 1378 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & … … 1430 1522 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1431 1523 1524 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1525 #if ! defined key_xios2 1432 1526 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1433 1527 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) … … 1435 1529 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1436 1530 ! 1437 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)1438 1531 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1532 #else 1533 ! Pas teste : attention aux indices ! 1534 CALL iom_set_domain_attr("ptr", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1535 CALL iom_set_domain_attr("ptr", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1536 CALL iom_set_domain_attr("ptr", lonvalue = zlon, & 1537 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1538 CALL iom_set_zoom_domain_attr ('ptr', ibegin=ix, nj=jpjglo) 1539 #endif 1540 1439 1541 CALL iom_update_file_name('ptr') 1440 1542 ! … … 1455 1557 zz=REAL(narea,wp) 1456 1558 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 1457 1559 1458 1560 END SUBROUTINE set_scalar 1459 1561 … … 1479 1581 REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings 1480 1582 REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings 1583 #if defined key_xios2 1584 TYPE(xios_duration) :: f_op, f_of 1585 #endif 1586 1481 1587 !!---------------------------------------------------------------------- 1482 1588 ! 1483 1589 ! frequency of the call of iom_put (attribut: freq_op) 1484 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 1485 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op = cl1//'ts', freq_offset='0ts') 1486 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op = cl1//'ts', freq_offset='0ts') 1487 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op = cl1//'ts', freq_offset='0ts') 1488 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op = cl1//'ts', freq_offset='0ts') 1590 #if ! defined key_xios2 1591 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts') 1592 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op=cl1//'ts', freq_offset='0ts') 1593 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op=cl1//'ts', freq_offset='0ts') 1594 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op=cl1//'ts', freq_offset='0ts') 1595 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op=cl1//'ts', freq_offset='0ts') 1596 #else 1597 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 1598 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of) 1599 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of) 1600 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of) 1601 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of) 1602 #endif 1489 1603 1490 1604 ! output file names (attribut: name) … … 1508 1622 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1509 1623 CALL dom_ngb( 0., 0., ix, iy, cl1 ) 1624 #if ! defined key_xios2 1510 1625 CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 1626 #else 1627 CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo) 1628 #endif 1511 1629 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 1512 1630 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') … … 1588 1706 ENDIF 1589 1707 clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 1708 #if ! defined key_xios2 1590 1709 CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 1710 #else 1711 CALL iom_set_zoom_domain_attr (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1) 1712 #endif 1591 1713 CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff ) 1592 1714 CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) … … 1617 1739 REAL(wp) :: zsec 1618 1740 LOGICAL :: llexist 1619 !!---------------------------------------------------------------------- 1741 #if defined key_xios2 1742 TYPE(xios_duration) :: output_freq 1743 #endif 1744 !!---------------------------------------------------------------------- 1745 1620 1746 1621 1747 DO jn = 1,2 1622 1748 #if ! defined key_xios2 1623 1749 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq ) 1750 #else 1751 output_freq = xios_duration(0,0,0,0,0,0) 1752 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = output_freq ) 1753 #endif 1624 1754 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 1625 1755 … … 1632 1762 END DO 1633 1763 1764 #if ! defined key_xios2 1634 1765 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1635 1766 DO WHILE ( idx /= 0 ) … … 1644 1775 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1645 1776 END DO 1646 1777 #else 1778 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1779 DO WHILE ( idx /= 0 ) 1780 IF ( output_freq%hour /= 0 ) THEN 1781 WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 1782 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1783 ELSE IF ( output_freq%day /= 0 ) THEN 1784 WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 1785 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1786 ELSE IF ( output_freq%month /= 0 ) THEN 1787 WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 1788 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1789 ELSE IF ( output_freq%year /= 0 ) THEN 1790 WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 1791 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1792 ELSE 1793 CALL ctl_stop('error in the name of file id '//TRIM(cdid), & 1794 & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 1795 ENDIF 1796 clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname)) 1797 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1798 END DO 1799 #endif 1647 1800 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1648 1801 DO WHILE ( idx /= 0 ) … … 1673 1826 END DO 1674 1827 1828 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1675 1829 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1676 1830 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) … … 1720 1874 ENDIF 1721 1875 1876 !$AGRIF_DO_NOT_TREAT 1877 ! Should be fixed in the conv 1722 1878 IF( llfull ) THEN 1723 1879 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" … … 1730 1886 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 1731 1887 ENDIF 1888 !$AGRIF_END_DO_NOT_TREAT 1732 1889 1733 1890 END FUNCTION iom_sdate -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r5429 r6204 298 298 ENDIF 299 299 300 #if defined key_agrif 301 IF (Agrif_Root()) THEN 302 CALL Agrif_MPI_Init(mpi_comm_opa) 303 ELSE 304 CALL Agrif_MPI_set_grid_comm(mpi_comm_opa) 305 ENDIF 306 #endif 307 300 308 CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 301 309 CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r5767 r6204 1290 1290 CHARACTER(LEN=*) , INTENT(in ) :: lsmfile ! land sea mask file name 1291 1291 !! 1292 REAL(wp),DIMENSION(:,:,:),ALLOCATABLE :: ztmp_fly_dta ,zfieldo! temporary array of values on input grid1292 REAL(wp),DIMENSION(:,:,:),ALLOCATABLE :: ztmp_fly_dta ! temporary array of values on input grid 1293 1293 INTEGER, DIMENSION(3) :: rec1,recn ! temporary arrays for start and length 1294 1294 INTEGER, DIMENSION(3) :: rec1_lsm,recn_lsm ! temporary arrays for start and length in case of seaoverland … … 1356 1356 1357 1357 1358 itmpi= SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),1)1359 itmpj= SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),2)1358 itmpi=jpi2_lsm-jpi1_lsm+1 1359 itmpj=jpj2_lsm-jpj1_lsm+1 1360 1360 itmpz=kk 1361 1361 ALLOCATE(ztmp_fly_dta(itmpi,itmpj,itmpz)) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5487 r6204 1029 1029 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1030 1030 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1031 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1031 1032 CALL iom_put( 'ssu_m', ssu_m ) 1032 1033 ENDIF … … 1034 1035 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1035 1036 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1037 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1036 1038 CALL iom_put( 'ssv_m', ssv_m ) 1037 1039 ENDIF … … 1743 1745 ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1744 1746 ELSEWHERE 1745 ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)1747 ztmp3(:,:,1) = rt0 1746 1748 END WHERE 1747 1749 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) … … 1774 1776 ! ! ------------------------- ! 1775 1777 IF( ssnd(jps_albice)%laction ) THEN ! ice 1776 SELECT CASE( sn_snd_alb%cldes ) 1777 CASE( 'ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1778 CASE( 'weighted ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1779 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1778 SELECT CASE( sn_snd_alb%cldes ) 1779 CASE( 'ice' ) 1780 SELECT CASE( sn_snd_alb%clcat ) 1781 CASE( 'yes' ) 1782 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1783 CASE( 'no' ) 1784 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1785 ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 1786 ELSEWHERE 1787 ztmp1(:,:) = albedo_oce_mix(:,:) 1788 END WHERE 1789 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) 1790 END SELECT 1791 CASE( 'weighted ice' ) ; 1792 SELECT CASE( sn_snd_alb%clcat ) 1793 CASE( 'yes' ) 1794 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1795 CASE( 'no' ) 1796 WHERE( fr_i (:,:) > 0. ) 1797 ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) 1798 ELSEWHERE 1799 ztmp1(:,:) = 0. 1800 END WHERE 1801 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' ) 1802 END SELECT 1803 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1780 1804 END SELECT 1781 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1782 ENDIF 1805 1806 SELECT CASE( sn_snd_alb%clcat ) 1807 CASE( 'yes' ) 1808 CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode 1809 CASE( 'no' ) 1810 CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1811 END SELECT 1812 ENDIF 1813 1783 1814 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 1784 1815 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r5720 r6204 53 53 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: risfLeff !:effective length (Leff) BG03 nn_isf==2 54 54 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point 55 #if defined key_agrif56 ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: misfkt, misfkb !:Level of ice shelf base58 !: (first wet level and last level include in the tbl)59 #else60 55 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: misfkt, misfkb !:Level of ice shelf base 61 #endif62 56 63 57 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r5503 r6204 126 126 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required 127 127 ! 128 ! Runoff reduction only associated to the ORCA2_LIM configuration129 ! when reading the NetCDF file runoff_1m_nomask.nc130 IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl ) THEN131 WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )132 sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)133 END WHERE134 ENDIF135 !136 128 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 137 129 ! -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r4990 r6204 212 212 CHARACTER(len=3) :: cdtype 213 213 REAL, DIMENSION(:,:,:) :: pun, pvn, pwn 214 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 214 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', & 215 & kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 215 216 END SUBROUTINE tra_adv_eiv 216 217 #endif -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r5147 r6204 326 326 CALL wrk_alloc( jpi, jpj, zwx_sav, zwy_sav ) 327 327 CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zhdiv, zwz_sav, zwzts ) 328 CALL wrk_alloc( jpi, jpj, jpk, 3, ztrs )328 CALL wrk_alloc( jpi, jpj, jpk, kjpt+1, ztrs ) 329 329 ! 330 330 IF( kt == kit000 ) THEN … … 564 564 ! 565 565 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz, zhdiv, zwz_sav, zwzts ) 566 CALL wrk_dealloc( jpi, jpj, jpk, 3, ztrs )566 CALL wrk_dealloc( jpi, jpj, jpk, kjpt+1, ztrs ) 567 567 CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 568 568 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r5628 r6204 47 47 USE timing ! Timing 48 48 #if defined key_agrif 49 USE agrif_opa_update50 49 USE agrif_opa_interp 51 50 #endif … … 111 110 ! Update after tracer on domain lateral boundaries 112 111 ! 112 #if defined key_agrif 113 CALL Agrif_tra ! AGRIF zoom boundaries 114 #endif 115 ! 113 116 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp ) ! local domain boundaries (T-point, unchanged sign) 114 117 CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) … … 116 119 #if defined key_bdy 117 120 IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 118 #endif119 #if defined key_agrif120 CALL Agrif_tra ! AGRIF zoom boundaries121 121 #endif 122 122 … … 149 149 ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level 150 150 ENDIF 151 ENDIF 152 ! 153 #if defined key_agrif 154 ! Update tracer at AGRIF zoom boundaries 155 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tra( kt ) ! children only 156 #endif 157 ! 158 ! trends computation 151 ENDIF 152 ! 153 ! trends computation 159 154 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 160 155 DO jk = 1, jpkm1 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r5215 r6204 117 117 ! 118 118 SELECT CASE( ktrd ) 119 120 121 122 123 124 125 126 127 128 119 CASE( jpdyn_hpg ) ; CALL iom_put( "ketrd_hpg", zke ) ! hydrostatic pressure gradient 120 CASE( jpdyn_spg ) ; CALL iom_put( "ketrd_spg", zke ) ! surface pressure gradient 121 CASE( jpdyn_spgexp ); CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit) 122 CASE( jpdyn_spgflt ); CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter) 123 CASE( jpdyn_pvo ) ; CALL iom_put( "ketrd_pvo", zke ) ! planetary vorticity 124 CASE( jpdyn_rvo ) ; CALL iom_put( "ketrd_rvo", zke ) ! relative vorticity (or metric term) 125 CASE( jpdyn_keg ) ; CALL iom_put( "ketrd_keg", zke ) ! Kinetic Energy gradient (or had) 126 CASE( jpdyn_zad ) ; CALL iom_put( "ketrd_zad", zke ) ! vertical advection 127 CASE( jpdyn_ldf ) ; CALL iom_put( "ketrd_ldf", zke ) ! lateral diffusion 128 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf", zke ) ! vertical diffusion 129 129 ! ! wind stress trends 130 131 132 133 134 135 136 137 138 139 140 141 142 130 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 131 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1) 132 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1) 133 zke2d(1,:) = 0._wp ; zke2d(:,1) = 0._wp 134 DO jj = 2, jpj 135 DO ji = 2, jpi 136 zke2d(ji,jj) = 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) & 137 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) 138 END DO 139 END DO 140 CALL iom_put( "ketrd_tau", zke2d ) 141 CALL wrk_dealloc( jpi, jpj , z2dx, z2dy, zke2d ) 142 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr", zke ) ! bottom friction (explicit case) 143 143 !!gm TO BE DONE properly 144 144 !!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... … … 162 162 ! ENDIF 163 163 !!gm end 164 164 CASE( jpdyn_atf ) ; CALL iom_put( "ketrd_atf", zke ) ! asselin filter trends 165 165 !! a faire !!!! idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 166 166 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... … … 184 184 ! CALL iom_put( "ketrd_bfri", zke2d ) 185 185 ! ENDIF 186 187 188 189 190 191 192 193 186 CASE( jpdyn_ken ) ; ! kinetic energy 187 ! called in dynnxt.F90 before asselin time filter 188 ! with putrd=ua and pvtrd=va 189 zke(:,:,:) = 0.5_wp * zke(:,:,:) 190 CALL iom_put( "KE", zke ) 191 ! 192 CALL ken_p2k( kt , zke ) 193 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 194 194 ! 195 195 END SELECT -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
r5215 r6204 165 165 166 166 167 168 167 SELECT CASE( ktrd ) 168 CASE( jptra_npc ) ! non-penetrative convection: regrouped with zdf 169 169 !!gm : to be completed ! 170 ! 170 ! IF( .... 171 171 !!gm end 172 173 172 CASE( jptra_zdfp ) ! iso-neutral diffusion: "pure" vertical diffusion 173 ! ! regroup iso-neutral diffusion in one term 174 174 tmltrd(:,:,jpmxl_ldf) = tmltrd(:,:,jpmxl_ldf) + ( tmltrd(:,:,jpmxl_zdf) - tmltrd(:,:,jpmxl_zdfp) ) 175 175 smltrd(:,:,jpmxl_ldf) = smltrd(:,:,jpmxl_ldf) + ( smltrd(:,:,jpmxl_zdf) - smltrd(:,:,jpmxl_zdfp) ) … … 811 811 812 812 813 813 nkstp = nit000 - 1 ! current time step indicator initialization 814 814 815 815 … … 851 851 IF( nn_ctls == 1 ) THEN 852 852 CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 853 READ ( inum ) nbol853 READ ( inum, * ) nbol 854 854 CLOSE( inum ) 855 855 END IF -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
r5215 r6204 99 99 CALL wrk_alloc( jpi, jpj, z2d ) 100 100 z2d(:,:) = wn(:,:,1) * ( & 101 102 103 &) / fse3t(:,:,1)101 & - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem) & 102 & + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal) & 103 & ) / fse3t(:,:,1) 104 104 CALL iom_put( "petrd_sad" , z2d ) 105 105 CALL wrk_dealloc( jpi, jpj, z2d ) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r4990 r6204 43 43 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avmu , avmv !: vertical viscosity coef at uw- & vw-pts [m2/s] 44 44 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avm , avt !: vertical viscosity & diffusivity coef at w-pt [m2/s] 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2] 45 48 46 49 !!---------------------------------------------------------------------- … … 60 63 & tfrua(jpi, jpj), tfrva(jpi, jpj) , & 61 64 & avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk) , & 62 & avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk) , STAT = zdf_oce_alloc ) 65 & avmv (jpi,jpj,jpk), avt (jpi,jpj,jpk) , & 66 & avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk) , & 67 & avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk) , & 68 & en (jpi,jpj,jpk), STAT = zdf_oce_alloc ) 63 69 ! 64 70 IF( zdf_oce_alloc /= 0 ) CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r5610 r6204 42 42 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag 43 43 ! 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy45 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 46 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k ! not enhanced Kz48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avm_k ! not enhanced Kz49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k ! not enhanced Kz50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmv_k ! not enhanced Kz51 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustars2 !: Squared surface velocity scale at T-points 52 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustarb2 !: Squared bottom velocity scale at T-points … … 120 115 !! *** FUNCTION zdf_gls_alloc *** 121 116 !!---------------------------------------------------------------------- 122 ALLOCATE( en(jpi,jpj,jpk), mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 123 & avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk), & 124 & avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), & 125 & ustars2(jpi,jpj), ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 117 ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 118 & ustars2(jpi,jpj) , ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 126 119 ! 127 120 IF( lk_mpp ) CALL mpp_sum ( zdf_gls_alloc ) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r5938 r6204 27 27 28 28 PUBLIC zdf_mxl ! called by step.F90 29 PUBLIC zdf_mxl_alloc ! Used in zdf_tke_init 29 30 30 31 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nmln !: number of level in the mixed layer (used by TOP) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r6113 r6204 53 53 USE timing ! Timing 54 54 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 55 #if defined key_agrif 56 USE agrif_opa_interp 57 USE agrif_opa_update 58 #endif 59 60 55 61 56 62 IMPLICIT NONE … … 85 91 REAL(wp) :: rhftau_scl = 1.0_wp ! scale factor applied to HF part of taum (nn_etau=3) 86 92 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2]88 93 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 89 94 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz92 95 #if defined key_c1d 93 96 ! !!** 1D cfg only ** ('key_c1d') … … 115 118 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 116 119 #endif 117 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , & 118 & avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk), & 119 & avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc ) 120 & htau (jpi,jpj) , dissl(jpi,jpj,jpk) , STAT= zdf_tke_alloc ) 120 121 ! 121 122 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) … … 189 190 avmv_k(:,:,:) = avmv(:,:,:) 190 191 ! 192 #if defined key_agrif 193 ! Update child grid f => parent grid 194 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tke( kt ) ! children only 195 #endif 196 ! 191 197 END SUBROUTINE zdf_tke 192 198 … … 317 323 zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 318 324 ! ! TKE Langmuir circulation source term 319 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 325 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) / & 326 & zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 320 327 END DO 321 328 END DO … … 710 717 !!---------------------------------------------------------------------- 711 718 INTEGER :: ji, jj, jk ! dummy loop indices 712 INTEGER :: ios 719 INTEGER :: ios, ierr 713 720 !! 714 721 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & … … 768 775 ENDIF 769 776 770 IF( nn_etau == 2 ) CALL zdf_mxl( nit000 ) ! Initialization of nmln 777 IF( nn_etau == 2 ) THEN 778 ierr = zdf_mxl_alloc() 779 nmln(:,:) = nlb10 ! Initialization of nmln 780 ENDIF 771 781 772 782 ! !* depth of penetration of surface tke -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5531 r6204 161 161 ENDIF 162 162 163 #if defined key_agrif 164 CALL Agrif_Regrid() 165 #endif 166 163 167 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 164 168 #if defined key_agrif 165 CALL Agrif_Step( stp )! AGRIF: time stepping169 CALL stp ! AGRIF: time stepping 166 170 #else 167 171 CALL stp( istp ) ! standard time stepping … … 187 191 ! 188 192 #if defined key_agrif 189 IF ( Agrif_Level() < Agrif_MaxLevel() ) THEN193 IF( .NOT. Agrif_Root() ) THEN 190 194 CALL Agrif_ParentGrid_To_ChildGrid() 191 195 IF( lk_diaobs ) CALL dia_obs_wri … … 336 340 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 337 341 #endif 338 ENDIF 342 ENDIF 339 343 jpk = jpkdta ! third dim 344 #if defined key_agrif 345 ! simple trick to use same vertical grid as parent 346 ! but different number of levels: 347 ! Save maximum number of levels in jpkdta, then define all vertical grids 348 ! with this number. 349 ! Suppress once vertical online interpolation is ok 350 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent(jpkdta) 351 #endif 340 352 jpim1 = jpi-1 ! inner domain indices 341 353 jpjm1 = jpj-1 ! " " … … 712 724 INTEGER :: ifac, jl, inu 713 725 INTEGER, PARAMETER :: ntest = 14 714 INTEGER :: ilfax(ntest) 715 ! 716 ! lfax contains the set of allowed factors. 717 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & 718 & 128, 64, 32, 16, 8, 4, 2 / 719 !!---------------------------------------------------------------------- 726 INTEGER, DIMENSION(ntest) :: ilfax 727 ! 728 ! ilfax contains the set of allowed factors. 729 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 730 !!---------------------------------------------------------------------- 731 ! ilfax contains the set of allowed factors. 732 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 720 733 721 734 ! Clear the error flag and initialise output vars -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/step.F90
r5510 r6204 50 50 51 51 #if defined key_agrif 52 SUBROUTINE stp( )52 RECURSIVE SUBROUTINE stp( ) 53 53 INTEGER :: kstp ! ocean time-step index 54 54 #else … … 79 79 #if defined key_agrif 80 80 kstp = nit000 + Agrif_Nb_Step() 81 ! IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 82 ! IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 81 IF ( lk_agrif_debug ) THEN 82 IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 83 IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint() 84 ENDIF 85 83 86 IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 87 84 88 # if defined key_iomput 85 89 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) … … 110 114 ! Update stochastic parameters and random T/S fluctuations 111 115 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 112 CALL sto_par( kstp ) ! Stochastic parameters 116 IF( ln_sto_eos ) CALL sto_par( kstp ) ! Stochastic parameters 117 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 113 118 114 119 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 152 157 ! 153 158 IF( lk_ldfslp ) THEN ! slope of lateral mixing 154 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations155 159 CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density 156 160 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 188 192 ! Note that the computation of vertical velocity above, hence "after" sea level 189 193 ! is necessary to compute momentum advection for the rhs of barotropic loop: 190 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations191 194 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 192 195 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 200 203 ua(:,:,:) = 0.e0 ! set dynamics trends to zero 201 204 va(:,:,:) = 0.e0 202 IF( l n_asmiau .AND. &205 IF( lk_asminc .AND. ln_asmiau .AND. & 203 206 & ln_dyninc ) CALL dyn_asm_inc ( kstp ) ! apply dynamics assimilation increment 204 207 IF( ln_neptsimp ) CALL dyn_nept_cor ( kstp ) ! subtract Neptune velocities (simplified) … … 248 251 tsa(:,:,:,:) = 0.e0 ! set tracer trends to zero 249 252 250 IF( l n_asmiau .AND. &253 IF( lk_asminc .AND. ln_asmiau .AND. & 251 254 & ln_trainc ) CALL tra_asm_inc( kstp ) ! apply tracer assimilation increment 252 255 CALL tra_sbc ( kstp ) ! surface boundary condition … … 270 273 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 271 274 CALL tra_nxt( kstp ) ! tracer fields at next time step 272 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations273 275 CALL eos ( tsa, rhd, rhop, fsdept_n(:,:,:) ) ! Time-filtered in situ density for hpg computation 274 276 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 281 283 ELSE ! centered hpg (eos then time stepping) 282 284 IF ( .NOT. lk_dynspg_ts ) THEN ! eos already called in time-split case 283 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations284 285 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 285 286 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 314 315 va(:,:,:) = 0.e0 315 316 316 IF( l n_asmiau .AND. &317 IF( lk_asminc .AND. ln_asmiau .AND. & 317 318 & ln_dyninc ) CALL dyn_asm_inc( kstp ) ! apply dynamics assimilation increment 318 319 IF( ln_bkgwri ) CALL asm_bkg_wri( kstp ) ! output background fields … … 335 336 CALL ssh_swp( kstp ) ! swap of sea surface height 336 337 IF( lk_vvl ) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 337 338 ! 339 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 340 341 #if defined key_agrif 342 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 343 ! AGRIF 344 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 345 CALL Agrif_Integrate_ChildGrids( stp ) 346 347 IF ( Agrif_NbStepint().EQ.0 ) THEN 348 CALL Agrif_Update_Tra() ! Update active tracers 349 CALL Agrif_Update_Dyn() ! Update momentum 350 ENDIF 351 #endif 338 352 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics 339 353 IF( lk_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 340 354 341 355 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 342 ! Control and restarts356 ! Control 343 357 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 344 358 CALL stp_ctl( kstp, indic ) … … 352 366 IF( lwm.AND.numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice 353 367 ENDIF 354 IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file355 368 356 369 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 367 380 ! 368 381 IF( nn_timing == 1 .AND. kstp == nit000 ) CALL timing_reset 382 ! 369 383 ! 370 384 END SUBROUTINE stp -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r5501 r6204 112 112 #if defined key_agrif 113 113 USE agrif_opa_sponge ! Momemtum and tracers sponges 114 USE agrif_opa_update ! Update (2-way nesting) 114 115 #endif 115 116 #if defined key_top -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
r3294 r6204 17 17 USE dom_oce ! ocean space and time domain variables 18 18 USE sol_oce ! ocean space and time domain variables 19 USE sbc_oce ! surface boundary conditions variables 19 20 USE in_out_manager ! I/O manager 20 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 22 23 USE dynspg_oce ! pressure gradient schemes 23 24 USE c1d ! 1D vertical configuration 25 24 26 25 27 IMPLICIT NONE … … 52 54 INTEGER, INTENT( inout ) :: kindic ! indicator of solver convergence 53 55 !! 56 CHARACTER(len = 32) :: clfname ! time stepping output file name 54 57 INTEGER :: ji, jj, jk ! dummy loop indices 55 58 INTEGER :: ii, ij, ik ! temporary integers … … 63 66 WRITE(numout,*) 'stp_ctl : time-stepping control' 64 67 WRITE(numout,*) '~~~~~~~' 65 ! open time.step file 66 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 68 ! open time.step file with special treatment for SAS 69 IF ( nn_components == jp_iam_sas ) THEN 70 clfname = 'time.step.sas' 71 ELSE 72 clfname = 'time.step' 73 ENDIF 74 CALL ctl_opn( numstp, TRIM(clfname), 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 67 75 ENDIF 68 76
Note: See TracChangeset
for help on using the changeset viewer.
