Changeset 12962
- Timestamp:
- 2020-05-22T16:18:18+02:00 (4 years ago)
- Location:
- NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo
- Files:
-
- 17 edited
-
cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg (modified) (1 diff)
-
src/OCE/DOM/dom_oce.F90 (modified) (1 diff)
-
src/OCE/DOM/domain.F90 (modified) (2 diffs)
-
src/OCE/DOM/domvvl.F90 (modified) (1 diff)
-
src/OCE/DOM/dtatsd.F90 (modified) (2 diffs)
-
src/OCE/IOM/iom.F90 (modified) (5 diffs)
-
src/OCE/LBC/mppini.F90 (modified) (4 diffs)
-
src/OCE/SBC/fldread.F90 (modified) (21 diffs)
-
src/OCE/SBC/sbcrnf.F90 (modified) (2 diffs)
-
src/OCE/USR/usrdef_fmask.F90 (modified) (1 diff)
-
src/OCE/ZDF/zdfiwm.F90 (modified) (10 diffs)
-
src/OFF/dtadyn.F90 (modified) (2 diffs)
-
src/OFF/nemogcm.F90 (modified) (1 diff)
-
src/SAO/nemogcm.F90 (modified) (1 diff)
-
src/SAS/nemogcm.F90 (modified) (1 diff)
-
src/SAS/sbcssm.F90 (modified) (2 diffs)
-
src/TOP/trcini.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg
r12377 r12962 89 89 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 90 90 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename ! 91 sn_wndi = 'u_10.15JUNE2009_fill' , 6. , 'U_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bicubic_noc.nc' , 'Uwnd' , '' 92 sn_wndj = 'v_10.15JUNE2009_fill' , 6. , 'V_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bicubic_noc.nc' , 'Vwnd' , '' 93 sn_qsr = 'ncar_rad.15JUNE2009_fill' , 24. , 'SWDN_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 94 sn_qlw = 'ncar_rad.15JUNE2009_fill' , 24. , 'LWDN_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 95 sn_tair = 't_10.15JUNE2009_fill' , 6. , 'T_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 96 sn_humi = 'q_10.15JUNE2009_fill' , 6. , 'Q_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 97 sn_prec = 'ncar_precip.15JUNE2009_fill', -1. , 'PRC_MOD1', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 98 sn_snow = 'ncar_precip.15JUNE2009_fill', -1. , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 99 sn_slp = 'slp.15JUNE2009_fill' , 6. , 'SLP' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 100 / 101 !----------------------------------------------------------------------- 102 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 103 !----------------------------------------------------------------------- 91 sn_wndi = 'u_10.15JUNE2009_fill' , 6. , 'U_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bicub' , 'Uwnd' , '' 92 sn_wndj = 'v_10.15JUNE2009_fill' , 6. , 'V_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bicub' , 'Vwnd' , '' 93 sn_qsr = 'ncar_rad.15JUNE2009_fill' , 24. , 'SWDN_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 94 sn_qlw = 'ncar_rad.15JUNE2009_fill' , 24. , 'LWDN_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 95 sn_tair = 't_10.15JUNE2009_fill' , 6. , 'T_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 96 sn_humi = 'q_10.15JUNE2009_fill' , 6. , 'Q_10_MOD', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 97 sn_prec = 'ncar_precip.15JUNE2009_fill', -1. , 'PRC_MOD1', .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 98 sn_snow = 'ncar_precip.15JUNE2009_fill', -1. , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 99 sn_slp = 'slp.15JUNE2009_fill' , 6. , 'SLP' , .false. , .true. , 'yearly' , 'weights_core2_orca2_bilin' , '' , '' 104 100 / 105 101 !----------------------------------------------------------------------- -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/DOM/dom_oce.F90
r12958 r12962 97 97 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig0 !: local ==> global domain, excluding halos (Ni0glo), i-index 98 98 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg0 !: local ==> global domain, excluding halos (Nj0glo), j-index 99 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig0_oldcmp !: local ==> global domain, excluding halos (Ni0glo), i-index 100 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg0_oldcmp !: local ==> global domain, excluding halos (Nj0glo), j-index 99 101 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mi0, mi1 !: global, including halos (jpiglo) ==> local domain i-index 100 102 ! !: (mi0=1 and mi1=0 if global index not in local domain) -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/DOM/domain.F90
r12958 r12962 217 217 !! - mig0, mjg0: local domain indices ==> global domain, excluding halos, indices 218 218 !! - mi0 , mi1 : global domain indices ==> local domain indices 219 !! - mj0 ,, mj1 (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)219 !! - mj0 , mj1 (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 220 220 !!---------------------------------------------------------------------- 221 221 INTEGER :: ji, jj ! dummy loop argument … … 230 230 ! ! local domain indices ==> global domain, excluding halos, indices 231 231 ! 232 mig0(:) = mig(:) - nn_hls 233 mjg0(:) = mjg(:) - nn_hls 232 234 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 233 235 ! we must define mig0 and mjg0 as bellow. 234 236 ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 235 !!$ mig0(:) = mig(:) - nn_hls 236 !!$ mjg0(:) = mjg(:) - nn_hls 237 mig0(:) = mig(:) - nn_hls + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 238 mjg0(:) = mjg(:) - nn_hls + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 237 mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 238 mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 239 239 ! 240 240 ! ! global domain, including halos, indices ==> local domain indices -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/DOM/domvvl.F90
r12958 r12962 261 261 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 262 262 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 263 ii0 = 103 ; ii1 = 111264 ij0 = 128 ; ij1 = 135 ;263 ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 264 ij0 = 128 + nn_hls ; ij1 = 135 + nn_hls 265 265 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 266 266 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/DOM/dtatsd.F90
r12377 r12962 153 153 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 154 154 ! 155 ij0 = 101 ; ij1 = 109! Reduced T & S in the Alboran Sea156 ii0 = 141 ; ii1 = 155155 ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea 156 ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1 157 157 DO jj = mj0(ij0), mj1(ij1) 158 158 DO ji = mi0(ii0), mi1(ii1) … … 167 167 END DO 168 168 END DO 169 ij0 = 87 ; ij1 = 96! Reduced temperature in Red Sea170 ii0 = 148 ; ii1 = 160169 ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea 170 ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 171 171 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 172 172 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/IOM/iom.F90
r12958 r12962 119 119 INTEGER :: Nis0_save, Nie0_save !: and close boundaries in output files 120 120 INTEGER :: Njs0_save, Nje0_save !: 121 INTEGER :: Ni_0_save, Nj_0_save !: 121 122 LOGICAL :: ll_closedef = .TRUE. 122 123 !!---------------------------------------------------------------------- … … 129 130 Nis0_save = Nis0 ; Nie0_save = Nie0 130 131 Njs0_save = Njs0 ; Nje0_save = Nje0 131 IF( nimpp == 1 ) Nis0 = 1 132 IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 133 IF( njmpp == 1 ) Njs0 = 1 134 IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 132 Ni_0_save = Ni_0 ; Nj_0_save = Nj_0 133 IF( mig( 1 ) == 1 ) Nis0 = 1 134 IF( mig(jpi) == jpiglo ) Nie0 = jpi 135 IF( mjg( 1 ) == 1 ) Njs0 = 1 136 IF( mjg(jpj) == jpjglo ) Nje0 = jpj 137 Ni_0 = Nie0 - Nis0 + 1 138 Nj_0 = Nje0 - Njs0 + 1 135 139 ENDIF 136 140 IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef … … 150 154 151 155 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 152 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00),&153 & start_date = xios_date(nyear,nmonth,nday,0,0,0) )154 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00),&155 & start_date = xios_date(nyear,nmonth,nday,0,0,0) )156 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00),&157 & start_date = xios_date(nyear,nmonth,nday,0,0,0) )156 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), & 157 & start_date = xios_date( nyear, nmonth, nday,0,0,0) ) 158 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), & 159 & start_date = xios_date( nyear, nmonth, nday,0,0,0) ) 160 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), & 161 & start_date = xios_date( nyear, nmonth, nday,0,0,0) ) 158 162 END SELECT 159 163 … … 284 288 Nis0 = Nis0_save ; Nie0 = Nie0_save 285 289 Njs0 = Njs0_save ; Nje0 = Nje0_save 290 Ni_0 = Ni_0_save ; Nj_0 = Nj_0_save 286 291 ENDIF 287 292 #endif … … 1162 1167 ELSE ! not a 1D array as pv_r1d requires jpdom_unknown 1163 1168 ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0 1164 IF( idom == jpdom_global ) istart(1:2) = (/ mig (Nis0)-nn_hls, mjg(Njs0)-nn_hls/)1169 IF( idom == jpdom_global ) istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /) 1165 1170 icnt(1:2) = (/ Ni_0, Nj_0 /) 1166 1171 IF( PRESENT(pv_r3d) ) THEN -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/LBC/mppini.F90
r12807 r12962 8 8 !! 8.0 ! 1998-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 9 9 !! NEMO 1.0 ! 2004-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1 10 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add init_nfdcom11 !! 3. ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) init_nfdcom: setup avoiding MPI communication10 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add init_nfdcom 11 !! 3. ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) init_nfdcom: setup avoiding MPI communication 12 12 !! 4.0 ! 2016-06 (G. Madec) use domain configuration file instead of bathymetry file 13 13 !! 4.0 ! 2017-06 (J.M. Molines, T. Lovato) merge of mppini and mppini_2 … … 1055 1055 !! *** ROUTINE mpp_init_nboce *** 1056 1056 !! 1057 !! ** Purpose : check for a mpi domain decomposition knbi x knbj which 1058 !! subdomains contain at least 1 ocean point 1057 !! ** Purpose : Check for a mpi domain decomposition knbi x knbj which 1058 !! subdomains, including 1 halo (even if nn_hls>1), contain 1059 !! at least 1 ocean point. 1060 !! We must indeed ensure that each subdomain that is a neighbour 1061 !! of a land subdomain as only land points on its boundary 1062 !! (inside the inner subdomain) with the land subdomain. 1063 !! This is needed to get the proper bondary conditions on 1064 !! a subdomain with a closed boundary. 1059 1065 !! 1060 1066 !! ** Method : read knbj strips (of length Ni0glo) of the land-sea mask … … 1066 1072 INTEGER, DIMENSION(knbi*knbj) :: inboce_1d 1067 1073 INTEGER :: idiv, iimax, ijmax, iarea 1074 INTEGER :: inx, iny, inry, isty 1068 1075 INTEGER :: ji, jn 1069 1076 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean … … 1086 1093 DO jn = 0, (knbj-1)/mppsize ! if mppsize < knbj : more strips than mpi processes (because of potential land domains) 1087 1094 ! 1088 iarea = (narea-1)/idiv + jn * mppsize ! involed process number (starting counting at 0)1089 IF( MOD( narea-1, idiv ) == 0 .AND. iarea < knbj ) THEN! beware idiv can be = to 11095 iarea = (narea-1)/idiv + jn * mppsize + 1 ! involed process number (starting counting at 1) 1096 IF( MOD( narea-1, idiv ) == 0 .AND. iarea <= knbj ) THEN ! beware idiv can be = to 1 1090 1097 ! 1091 1098 ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ijpi(knbi,knbj), ijpj(knbi,knbj) ) 1092 1099 CALL basic_decomposition( Ni0glo, Nj0glo, 0, knbi, knbj, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj ) 1093 1100 ! 1094 ALLOCATE( lloce(Ni0glo, ijpj(1,iarea+1)) ) ! allocate the strip 1095 CALL readbot_strip( ijmppt(1,iarea+1), ijpj(1,iarea+1), lloce ) ! read the strip 1101 inx = Ni0glo + 2 ; iny = ijpj(1,iarea) + 2 ! strip size + 1 halo on each direction (even if nn_hls>1) 1102 ALLOCATE( lloce(inx, iny) ) ! allocate the strip 1103 inry = iny - COUNT( (/ iarea == 1, iarea == knbj /) ) ! number of point to read in y-direction 1104 isty = 1 + COUNT( (/ iarea == 1 /) ) ! read from the first or the second line? 1105 CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip 1106 ! 1107 IF( iarea == 1 ) THEN ! the first line was not read 1108 IF( jperio == 2 .OR. jperio == 7 ) THEN ! north-south periodocity 1109 CALL readbot_strip( Nj0glo, 1, lloce(2:inx-1, 1) ) ! read the last line -> first line of lloce 1110 ELSE 1111 lloce(2:inx-1, 1) = .FALSE. ! closed boundary 1112 ENDIF 1113 ENDIF 1114 IF( iarea == knbj ) THEN ! the last line was not read 1115 IF( jperio == 2 .OR. jperio == 7 ) THEN ! north-south periodocity 1116 CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) ) ! read the first line -> last line of lloce 1117 ELSE 1118 lloce(2:inx-1,iny) = .FALSE. ! closed boundary 1119 ENDIF 1120 ENDIF 1121 ! ! first and last column were not read 1122 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 1123 lloce(1,:) = lloce(inx-1,:) ; lloce(inx,:) = lloce(2,:) ! east-west periodocity 1124 ELSE 1125 lloce(1,:) = .FALSE. ; lloce(inx,:) = .FALSE. ! closed boundary 1126 ENDIF 1127 ! 1096 1128 DO ji = 1, knbi 1097 inboce(ji,iarea +1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ijpi(ji,1)-1,:) ) ! number of ocean point in subdomain1129 inboce(ji,iarea) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ijpi(ji,1)+1,:) ) ! lloce as 2 points more than Ni0glo 1098 1130 END DO 1099 1131 ! -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/SBC/fldread.F90
r12866 r12962 53 53 LOGICAL :: ln_tint ! time interpolation or not (T/F) 54 54 LOGICAL :: ln_clim ! climatology or not (T/F) 55 CHARACTER(len = 8) :: cl type! type of data file 'daily', 'monthly' or yearly'55 CHARACTER(len = 8) :: clftyp ! type of data file 'daily', 'monthly' or yearly' 56 56 CHARACTER(len = 256) :: wname ! generic name of a NetCDF weights file to be used, blank if not 57 57 CHARACTER(len = 34) :: vcomp ! symbolic component name if a vector that needs rotation … … 69 69 LOGICAL :: ln_tint ! time interpolation or not (T/F) 70 70 LOGICAL :: ln_clim ! climatology or not (T/F) 71 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly' 71 CHARACTER(len = 8) :: clftyp ! type of data file 'daily', 'monthly' or yearly' 72 CHARACTER(len = 1) :: cltype ! nature of grid-points: T, U, V... 73 REAL(wp) :: zsgn ! -1. the sign change across the north fold, = 1. otherwise 72 74 INTEGER :: num ! iom id of the jpfld files to be read 73 75 INTEGER , DIMENSION(2,2) :: nrec ! before/after record (1: index, 2: second since Jan. 1st 00h of yr nit000) 74 76 INTEGER :: nbb ! index of before values 75 77 INTEGER :: naa ! index of after values 76 INTEGER , ALLOCATABLE, DIMENSION(: 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: fnow ! input fields interpolated to now time step78 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: fdta ! 2 consecutive record of input fields78 INTEGER , ALLOCATABLE, DIMENSION(:) :: nrecsec ! 79 REAL(wp), POINTER, DIMENSION(:,:,: ) :: fnow ! input fields interpolated to now time step 80 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: fdta ! 2 consecutive record of input fields 79 81 CHARACTER(len = 256) :: wgtname ! current name of the NetCDF weight file acting as a key 80 82 ! ! into the WGTLIST structure … … 351 353 INTEGER :: iaa ! shorter name for sdjf%naa 352 354 INTEGER :: iw ! index into wgts array 353 INTEGER :: ipdom ! index of the domain354 355 INTEGER :: idvar ! variable ID 355 356 INTEGER :: idmspc ! number of spatial dimensions 356 357 LOGICAL :: lmoor ! C1D case: point data 357 !!--------------------------------------------------------------------- 358 ! 359 ipk = SIZE( sdjf%fnow, 3 ) 358 REAL(wp), DIMENSION(:,:,:), POINTER :: dta_alias ! short cut 359 !!--------------------------------------------------------------------- 360 360 iaa = sdjf%naa 361 361 ! 362 IF( ASSOCIATED(sdjf%imap) ) THEN 363 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,iaa), sdjf%nrec(1,iaa), & 364 & sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 365 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec(1,iaa), & 366 & sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 367 ENDIF 368 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 362 IF( sdjf%ln_tint ) THEN ; dta_alias => sdjf%fdta(:,:,:,iaa) 363 ELSE ; dta_alias => sdjf%fnow(:,:,: ) 364 ENDIF 365 ipk = SIZE( dta_alias, 3 ) 366 ! 367 IF( ASSOCIATED(sdjf%imap) ) THEN ! BDY case 368 CALL fld_map( sdjf%num, sdjf%clvar, dta_alias(:,:,:), sdjf%nrec(1,iaa), & 369 & sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 370 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN ! On-the-fly interpolation 369 371 CALL wgt_list( sdjf, iw ) 370 IF( sdjf%ln_tint ) THEN ; CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fdta(:,:,:,iaa), & 371 & sdjf%nrec(1,iaa), sdjf%lsmname ) 372 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,iaa), 'T', 1._wp, kfillmode = jpfillcopy ) 373 ELSE ; CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fnow(:,:,: ), & 374 & sdjf%nrec(1,iaa), sdjf%lsmname ) 375 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,: ), 'T', 1._wp, kfillmode = jpfillcopy ) 376 ENDIF 377 ELSE 378 IF( SIZE(sdjf%fnow, 1) == jpi ) THEN ; ipdom = jpdom_global 379 ELSE ; ipdom = jpdom_unknown 380 ENDIF 372 CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, dta_alias(:,:,:), sdjf%nrec(1,iaa), sdjf%lsmname ) 373 CALL lbc_lnk( 'fldread', dta_alias(:,:,:), sdjf%cltype, sdjf%zsgn, kfillmode = jpfillcopy ) 374 ELSE ! default case 381 375 ! C1D case: If product of spatial dimensions == ipk, then x,y are of 382 376 ! size 1 (point/mooring data): this must be read onto the central grid point 383 377 idvar = iom_varid( sdjf%num, sdjf%clvar ) 384 378 idmspc = iom_file ( sdjf%num )%ndims( idvar ) 385 IF( iom_file( sdjf%num )%luld( idvar ) ) idmspc = idmspc - 1 386 lmoor = ( idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk ) 387 ! 388 SELECT CASE( ipk ) 389 CASE(1) 390 IF( lk_c1d .AND. lmoor ) THEN 391 IF( sdjf%ln_tint ) THEN 392 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fdta(2,2,1,iaa), sdjf%nrec(1,iaa) ) 393 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,1,iaa),'T',1., kfillmode = jpfillcopy ) 394 ELSE 395 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fnow(2,2,1 ), sdjf%nrec(1,iaa) ) 396 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,1 ),'T',1., kfillmode = jpfillcopy ) 397 ENDIF 398 ELSE 399 IF( sdjf%ln_tint ) THEN 400 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,iaa), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 401 ELSE 402 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 403 ENDIF 404 ENDIF 405 CASE DEFAULT 406 IF(lk_c1d .AND. lmoor ) THEN 407 IF( sdjf%ln_tint ) THEN 408 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,iaa), sdjf%nrec(1,iaa) ) 409 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,iaa),'T',1., kfillmode = jpfillcopy ) 410 ELSE 411 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(2,2,: ), sdjf%nrec(1,iaa) ) 412 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,: ),'T',1., kfillmode = jpfillcopy ) 413 ENDIF 414 ELSE 415 IF( sdjf%ln_tint ) THEN 416 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,iaa), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 417 ELSE 418 CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec(1,iaa), kfill = jpfillcopy ) 419 ENDIF 420 ENDIF 421 END SELECT 379 IF( iom_file( sdjf%num )%luld( idvar ) ) idmspc = idmspc - 1 ! id of the last spatial dimension 380 lmoor = ( idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk ) 381 ! 382 IF( lk_c1d .AND. lmoor ) THEN 383 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, dta_alias(2,2,:), sdjf%nrec(1,iaa) ) ! jpdom_unknown -> no lbc_lnk 384 CALL lbc_lnk( 'fldread', dta_alias(:,:,:), 'T', 1., kfillmode = jpfillcopy ) 385 ELSE 386 CALL iom_get( sdjf%num, jpdom_global, sdjf%clvar, dta_alias(:,:,:), sdjf%nrec(1,iaa), & 387 & sdjf%cltype, sdjf%zsgn, kfill = jpfillcopy ) 388 ENDIF 422 389 ENDIF 423 390 ! … … 458 425 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zdta_read_z ! work space local data requiring vertical interpolation 459 426 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zdta_read_dz ! work space local data requiring vertical interpolation 460 CHARACTER(LEN=1),DIMENSION(3) :: cl grid427 CHARACTER(LEN=1),DIMENSION(3) :: cltype 461 428 LOGICAL :: lluld ! is the variable using the unlimited dimension 462 429 LOGICAL :: llzint ! local value of ldzint 463 430 !!--------------------------------------------------------------------- 464 431 ! 465 cl grid= (/'t','u','v'/)432 cltype = (/'t','u','v'/) 466 433 ! 467 434 ipi = SIZE( pdta, 1 ) … … 498 465 IF( ipkb /= ipk .OR. llzint ) THEN ! boundary data not on model vertical grid : vertical interpolation 499 466 ! 500 IF( ipk == jpk .AND. iom_varid(knum,'gdep'//cl grid(kgrd)) /= -1 .AND. iom_varid(knum,'e3'//clgrid(kgrd)) /= -1 ) THEN467 IF( ipk == jpk .AND. iom_varid(knum,'gdep'//cltype(kgrd)) /= -1 .AND. iom_varid(knum,'e3'//cltype(kgrd)) /= -1 ) THEN 501 468 502 469 ALLOCATE( zdta_read(ipi,ipj,ipkb), zdta_read_z(ipi,ipj,ipkb), zdta_read_dz(ipi,ipj,ipkb) ) 503 470 504 471 CALL fld_map_core( zz_read, kmap, zdta_read ) 505 CALL iom_get ( knum, jpdom_unknown, 'gdep'//cl grid(kgrd), zz_read ) ! read only once? Potential temporal evolution?472 CALL iom_get ( knum, jpdom_unknown, 'gdep'//cltype(kgrd), zz_read ) ! read only once? Potential temporal evolution? 506 473 CALL fld_map_core( zz_read, kmap, zdta_read_z ) 507 CALL iom_get ( knum, jpdom_unknown, 'e3'//cl grid(kgrd), zz_read ) ! read only once? Potential temporal evolution?474 CALL iom_get ( knum, jpdom_unknown, 'e3'//cltype(kgrd), zz_read ) ! read only once? Potential temporal evolution? 508 475 CALL fld_map_core( zz_read, kmap, zdta_read_dz ) 509 476 … … 515 482 IF( ipk /= jpk ) CALL ctl_stop( 'fld_map : this should be an impossible case...' ) 516 483 WRITE(ctmp1,*) 'fld_map : vertical interpolation for bdy variable '//TRIM(cdvar)//' requires ' 517 IF( iom_varid(knum, 'gdep'//cl grid(kgrd)) == -1 ) CALL ctl_stop( ctmp1//'gdep'//clgrid(kgrd)//' variable' )518 IF( iom_varid(knum, 'e3'//cl grid(kgrd)) == -1 ) CALL ctl_stop( ctmp1// 'e3'//clgrid(kgrd)//' variable' )484 IF( iom_varid(knum, 'gdep'//cltype(kgrd)) == -1 ) CALL ctl_stop( ctmp1//'gdep'//cltype(kgrd)//' variable' ) 485 IF( iom_varid(knum, 'e3'//cltype(kgrd)) == -1 ) CALL ctl_stop( ctmp1// 'e3'//cltype(kgrd)//' variable' ) 519 486 520 487 ENDIF … … 739 706 CHARACTER (LEN=100) :: clcomp ! dummy weight name 740 707 REAL(wp), DIMENSION(jpi,jpj) :: utmp, vtmp ! temporary arrays for vector rotation 708 REAL(wp), DIMENSION(:,:,:), POINTER :: dta_u, dta_v ! short cut 741 709 !!--------------------------------------------------------------------- 742 710 ! … … 758 726 END DO 759 727 IF( iv > 0 ) THEN ! fields ju and iv are two components which need to be rotated together 728 IF( sd(ju)%ln_tint ) THEN ; dta_u => sd(ju)%fdta(:,:,:,jn) ; dta_v => sd(iv)%fdta(:,:,:,jn) 729 ELSE ; dta_u => sd(ju)%fnow(:,:,: ) ; dta_v => sd(iv)%fnow(:,:,: ) 730 ENDIF 760 731 DO jk = 1, SIZE( sd(ju)%fnow, 3 ) 761 IF( sd(ju)%ln_tint )THEN 762 CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->i', utmp(:,:) ) 763 CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->j', vtmp(:,:) ) 764 sd(ju)%fdta(:,:,jk,jn) = utmp(:,:) ; sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:) 765 ELSE 766 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->i', utmp(:,:) ) 767 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->j', vtmp(:,:) ) 768 sd(ju)%fnow(:,:,jk ) = utmp(:,:) ; sd(iv)%fnow(:,:,jk ) = vtmp(:,:) 769 ENDIF 732 CALL rot_rep( dta_u(:,:,jk), dta_v(:,:,jk), 'T', 'en->i', utmp(:,:) ) 733 CALL rot_rep( dta_u(:,:,jk), dta_v(:,:,jk), 'T', 'en->j', vtmp(:,:) ) 734 dta_u(:,:,jk) = utmp(:,:) ; dta_v(:,:,jk) = vtmp(:,:) 770 735 END DO 771 736 sd(ju)%rotn(jn) = .TRUE. ! vector was rotated … … 813 778 814 779 ! current file parameters 815 IF( sdjf%cl type(1:4) == 'week' ) THEN! find the day of the beginning of the current week816 isecwk = ksec_week( sdjf%cl type(6:8) ) ! seconds between the beginning of the week and half of current time step817 llprevmt = isecwk > nsec_month 780 IF( sdjf%clftyp(1:4) == 'week' ) THEN ! find the day of the beginning of the current week 781 isecwk = ksec_week( sdjf%clftyp(6:8) ) ! seconds between the beginning of the week and half of current time step 782 llprevmt = isecwk > nsec_month ! longer time since beginning of the current week than the current month 818 783 llprevyr = llprevmt .AND. nmonth == 1 819 784 iyr = nyear - COUNT((/llprevyr/)) 820 785 imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 821 786 idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 822 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and current week beginning787 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and current week beginning 823 788 ELSE 824 789 iyr = nyear … … 830 795 ! previous file parameters 831 796 IF( llprev ) THEN 832 IF( sdjf%cl type(1:4) == 'week' ) THEN! find the day of the beginning of previous week833 isecwk = isecwk + 7 * idaysec ! seconds between the beginning of previous week and half of the time step834 llprevmt = isecwk > nsec_month 797 IF( sdjf%clftyp(1:4) == 'week' ) THEN ! find the day of the beginning of previous week 798 isecwk = isecwk + 7 * idaysec ! seconds between the beginning of previous week and half of the time step 799 llprevmt = isecwk > nsec_month ! longer time since beginning of the previous week than the current month 835 800 llprevyr = llprevmt .AND. nmonth == 1 836 801 iyr = nyear - COUNT((/llprevyr/)) 837 802 imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 838 803 idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 839 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and previous week beginning804 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and previous week beginning 840 805 ELSE 841 idy = nday - COUNT((/ sdjf%cl type== 'daily' /))842 imt = nmonth - COUNT((/ sdjf%cl type== 'monthly' .OR. idy == 0 /))843 iyr = nyear - COUNT((/ sdjf%cl type== 'yearly' .OR. imt == 0 /))806 idy = nday - COUNT((/ sdjf%clftyp == 'daily' /)) 807 imt = nmonth - COUNT((/ sdjf%clftyp == 'monthly' .OR. idy == 0 /)) 808 iyr = nyear - COUNT((/ sdjf%clftyp == 'yearly' .OR. imt == 0 /)) 844 809 IF( idy == 0 ) idy = nmonth_len(imt) 845 810 IF( imt == 0 ) imt = 12 … … 850 815 ! next file parameters 851 816 IF( llnext ) THEN 852 IF( sdjf%cl type(1:4) == 'week' ) THEN! find the day of the beginning of next week853 isecwk = 7 * idaysec - isecwk ! seconds between half of the time step and the beginning of next week817 IF( sdjf%clftyp(1:4) == 'week' ) THEN ! find the day of the beginning of next week 818 isecwk = 7 * idaysec - isecwk ! seconds between half of the time step and the beginning of next week 854 819 llnextmt = isecwk > ( nmonth_len(nmonth)*idaysec - nsec_month ) ! larger than the seconds to the end of the month 855 820 llnextyr = llnextmt .AND. nmonth == 12 … … 857 822 imt = nmonth + COUNT((/llnextmt/)) - 12 * COUNT((/llnextyr/)) 858 823 idy = nday - nmonth_len(nmonth) * COUNT((/llnextmt/)) + isecwk / idaysec + 1 859 isecwk = nsec_year + isecwk ! seconds between 00h jan 1st of current year and next week beginning824 isecwk = nsec_year + isecwk ! seconds between 00h jan 1st of current year and next week beginning 860 825 ELSE 861 idy = nday + COUNT((/ sdjf%cl type== 'daily' /))862 imt = nmonth + COUNT((/ sdjf%cl type== 'monthly' .OR. idy > nmonth_len(nmonth) /))863 iyr = nyear + COUNT((/ sdjf%cl type== 'yearly' .OR. imt == 13 /))826 idy = nday + COUNT((/ sdjf%clftyp == 'daily' /)) 827 imt = nmonth + COUNT((/ sdjf%clftyp == 'monthly' .OR. idy > nmonth_len(nmonth) /)) 828 iyr = nyear + COUNT((/ sdjf%clftyp == 'yearly' .OR. imt == 13 /)) 864 829 IF( idy > nmonth_len(nmonth) ) idy = 1 865 830 IF( imt == 13 ) imt = 1 … … 878 843 IF ( NINT(sdjf%freqh) == -12 ) THEN ; ireclast = 1 ! yearly mean: consider only 1 record 879 844 ELSEIF( NINT(sdjf%freqh) == -1 ) THEN ! monthly mean: 880 IF( sdjf%cl type== 'monthly' ) THEN ; ireclast = 1 ! consider that the file has 1 record845 IF( sdjf%clftyp == 'monthly' ) THEN ; ireclast = 1 ! consider that the file has 1 record 881 846 ELSE ; ireclast = 12 ! consider that the file has 12 record 882 847 ENDIF 883 848 ELSE ! higher frequency mean (in hours) 884 IF( sdjf%cl type== 'monthly' ) THEN ; ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh )885 ELSEIF( sdjf%cl type(1:4) == 'week' ) THEN ; ireclast = NINT( 24. * 7. / sdjf%freqh )886 ELSEIF( sdjf%cl type== 'daily' ) THEN ; ireclast = NINT( 24. / sdjf%freqh )849 IF( sdjf%clftyp == 'monthly' ) THEN ; ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh ) 850 ELSEIF( sdjf%clftyp(1:4) == 'week' ) THEN ; ireclast = NINT( 24. * 7. / sdjf%freqh ) 851 ELSEIF( sdjf%clftyp == 'daily' ) THEN ; ireclast = NINT( 24. / sdjf%freqh ) 887 852 ELSE ; ireclast = NINT( 24. * REAL( nyear_len(indexyr), wp) / sdjf%freqh ) 888 853 ENDIF … … 902 867 sdjf%nrecsec(1) = sdjf%nrecsec(0) + nyear_len( indexyr ) * idaysec 903 868 ELSEIF( NINT(sdjf%freqh) == -1 ) THEN ! monthly mean: 904 IF( sdjf%cl type== 'monthly' ) THEN ! monthly file869 IF( sdjf%clftyp == 'monthly' ) THEN ! monthly file 905 870 sdjf%nrecsec(0 ) = nsec1jan000 + nmonth_beg(indexmt ) 906 871 sdjf%nrecsec(1 ) = nsec1jan000 + nmonth_beg(indexmt+1) … … 910 875 ENDIF 911 876 ELSE ! higher frequency mean (in hours) 912 IF( sdjf%cl type== 'monthly' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt)913 ELSEIF( sdjf%cl type(1:4) == 'week' ) THEN ; istart = nsec1jan000 + isecwk914 ELSEIF( sdjf%cl type== 'daily' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec877 IF( sdjf%clftyp == 'monthly' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt) 878 ELSEIF( sdjf%clftyp(1:4) == 'week' ) THEN ; istart = nsec1jan000 + isecwk 879 ELSEIF( sdjf%clftyp == 'daily' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec 915 880 ELSEIF( indexyr == 0 ) THEN ; istart = nsec1jan000 - nyear_len( 0 ) * idaysec 916 881 ELSEIF( indexyr == 2 ) THEN ; istart = nsec1jan000 + nyear_len( 1 ) * idaysec … … 1008 973 sdf(jf)%ln_tint = sdf_n(jf)%ln_tint 1009 974 sdf(jf)%ln_clim = sdf_n(jf)%ln_clim 1010 sdf(jf)%cltype = sdf_n(jf)%cltype 975 sdf(jf)%clftyp = sdf_n(jf)%clftyp 976 sdf(jf)%cltype = 'T' ! by default don't do any call to lbc_lnk in iom_get 977 sdf(jf)%zsgn = 1. ! by default don't do change signe across the north fold 1011 978 sdf(jf)%num = -1 1012 979 sdf(jf)%nbb = 1 ! start with before data in 1 … … 1018 985 sdf(jf)%vcomp = sdf_n(jf)%vcomp 1019 986 sdf(jf)%rotn(:) = .TRUE. ! pretend to be rotated -> won't try to rotate data before the first call to fld_get 1020 IF( sdf(jf)%cl type(1:4) == 'week' .AND. nn_leapy == 0 ) &987 IF( sdf(jf)%clftyp(1:4) == 'week' .AND. nn_leapy == 0 ) & 1021 988 & CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs nn_leapy = 1') 1022 IF( sdf(jf)%cl type(1:4) == 'week' .AND. sdf(jf)%ln_clim ) &989 IF( sdf(jf)%clftyp(1:4) == 'week' .AND. sdf(jf)%ln_clim ) & 1023 990 & CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs ln_clim = .FALSE.') 1024 991 sdf(jf)%nreclast = -1 ! Set to non zero default value to avoid errors, is updated to meaningful value during fld_clopn … … 1046 1013 WRITE(numout,*) ' weights: ' , TRIM( sdf(jf)%wgtname ), & 1047 1014 & ' pairing: ' , TRIM( sdf(jf)%vcomp ), & 1048 & ' data type: ' , sdf(jf)%cl type, &1015 & ' data type: ' , sdf(jf)%clftyp , & 1049 1016 & ' land/sea mask:' , TRIM( sdf(jf)%lsmname ) 1050 1017 call flush(numout) … … 1202 1169 CALL iom_get ( inum, jpdom_global, clname, data_tmp(:,:), cd_type = 'Z' ) ! no call to lbc_lnk 1203 1170 DO_2D_00_00 1204 !!$ isrc = NINT(data_tmp(ji,jj)) - 1 1205 isrc = INT(data_tmp(ji,jj)) - 1 1171 isrc = NINT(data_tmp(ji,jj)) - 1 1206 1172 ref_wgts(nxt_wgt)%data_jpi(ji,jj,jn) = 1 + MOD(isrc, ref_wgts(nxt_wgt)%ddims(1)) 1207 1173 ref_wgts(nxt_wgt)%data_jpj(ji,jj,jn) = 1 + isrc / ref_wgts(nxt_wgt)%ddims(1) … … 1589 1555 IF( .NOT. sdjf%ln_clim ) THEN 1590 1556 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 1591 IF( sdjf%cl type/= 'yearly' ) WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname ), kmonth ! add month1557 IF( sdjf%clftyp /= 'yearly' ) WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname ), kmonth ! add month 1592 1558 ELSE 1593 1559 ! build the new filename if climatological data 1594 IF( sdjf%cl type/= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month1595 ENDIF 1596 IF( sdjf%cl type == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &1560 IF( sdjf%clftyp /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month 1561 ENDIF 1562 IF( sdjf%clftyp == 'daily' .OR. sdjf%clftyp(1:4) == 'week' ) & 1597 1563 & WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), kday ! add day 1598 1564 … … 1618 1584 IF( cl_week(ijul) == TRIM(cdday) ) EXIT 1619 1585 END DO 1620 IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cl type(6:8): '//TRIM(cdday) )1586 IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%clftyp(6:8): '//TRIM(cdday) ) 1621 1587 ! 1622 1588 ishift = ijul * NINT(rday) -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/SBC/sbcrnf.F90
r12810 r12962 353 353 rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 354 354 IF( .NOT. sn_dep_rnf%ln_clim ) THEN ; WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear ! add year 355 IF( sn_dep_rnf%cl type== 'monthly' ) WRITE(rn_dep_file, '(a,"m",i2)' ) TRIM( rn_dep_file ), nmonth ! add month355 IF( sn_dep_rnf%clftyp == 'monthly' ) WRITE(rn_dep_file, '(a,"m",i2)' ) TRIM( rn_dep_file ), nmonth ! add month 356 356 ENDIF 357 357 CALL iom_open ( rn_dep_file, inum ) ! open file … … 518 518 cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname ) 519 519 IF( .NOT. sn_cnf%ln_clim ) THEN ; WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear ! add year 520 IF( sn_cnf%cl type== 'monthly' ) WRITE(cl_rnfile, '(a,"m",i2)' ) TRIM( cl_rnfile ), nmonth ! add month520 IF( sn_cnf%clftyp == 'monthly' ) WRITE(cl_rnfile, '(a,"m",i2)' ) TRIM( cl_rnfile ), nmonth ! add month 521 521 ENDIF 522 522 ! -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/USR/usrdef_fmask.F90
r12866 r12962 68 68 ! 69 69 IF(lwp) WRITE(numout,*) ' Gibraltar ' 70 ij0 = 101+1 ; ij1 = 101+1 ! Gibraltar strait : partial slip (pfmsk=0.5) 71 ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 72 ij0 = 102+1 ; ij1 = 102+1 73 ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 70 ij0 = 101 + nn_hls ; ij1 = 101 + nn_hls ! Gibraltar strait : partial slip (pfmsk=0.5) 71 ii0 = 139 + nn_hls - 1 ; ii1 = 140 + nn_hls - 1 72 pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 73 ij0 = 102 + nn_hls ; ij1 = 102 + nn_hls 74 ii0 = 139 + nn_hls - 1 ; ii1 = 140 + nn_hls - 1 75 pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 74 76 ! 75 77 IF(lwp) WRITE(numout,*) ' Bab el Mandeb ' 76 ij0 = 87+1 ; ij1 = 88+1 ! Bab el Mandeb : partial slip (pfmsk=1) 77 ii0 = 160 ; ii1 = 160 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 78 ij0 = 88+1 ; ij1 = 88+1 79 ii0 = 159 ; ii1 = 159 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 78 ij0 = 87 + nn_hls ; ij1 = 88 + nn_hls ! Bab el Mandeb : partial slip (pfmsk=1) 79 ii0 = 160 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 80 pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 81 ij0 = 88 + nn_hls ; ij1 = 88 + nn_hls 82 ii0 = 159 + nn_hls - 1 ; ii1 = 159 + nn_hls - 1 83 pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 80 84 ! 81 85 ! We keep this as an example but it is instable in this case -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/ZDF/zdfiwm.F90
r12510 r12962 139 139 !!---------------------------------------------------------------------- 140 140 ! 141 ! !* Set to zero the 1st and last vertical levels of appropriate variables 142 zemx_iwm (:,:,1) = 0._wp ; zemx_iwm (:,:,jpk) = 0._wp 143 zav_ratio(:,:,1) = 0._wp ; zav_ratio(:,:,jpk) = 0._wp 144 zav_wave (:,:,1) = 0._wp ; zav_wave (:,:,jpk) = 0._wp 141 ! 142 ! Set to zero the 1st and last vertical levels of appropriate variables 143 IF( iom_use("emix_iwm") ) THEN 144 DO_2D_00_00 145 zemx_iwm (ji,jj,1) = 0._wp ; zemx_iwm (ji,jj,jpk) = 0._wp 146 END_2D 147 zemx_iwm ( 1:nn_hls,:,:) = 0._wp ; zemx_iwm (:, 1:nn_hls,:) = 0._wp 148 zemx_iwm (jpi-nn_hls+1:jpi ,:,:) = 0._wp ; zemx_iwm (:,jpj-nn_hls+1: jpj,:) = 0._wp 149 ENDIF 150 IF( iom_use("av_ratio") ) THEN 151 DO_2D_00_00 152 zav_ratio(ji,jj,1) = 0._wp ; zav_ratio(ji,jj,jpk) = 0._wp 153 END_2D 154 zav_ratio( 1:nn_hls,:,:) = 0._wp ; zav_ratio(:, 1:nn_hls,:) = 0._wp 155 zav_ratio(jpi-nn_hls+1:jpi ,:,:) = 0._wp ; zav_ratio(:,jpj-nn_hls+1: jpj,:) = 0._wp 156 ENDIF 157 IF( iom_use("av_wave") ) THEN 158 DO_2D_00_00 159 zav_wave (ji,jj,1) = 0._wp ; zav_wave (ji,jj,jpk) = 0._wp 160 END_2D 161 zav_wave( 1:nn_hls,:,:) = 0._wp ; zav_wave(:, 1:nn_hls,:) = 0._wp 162 zav_wave(jpi-nn_hls+1:jpi ,:,:) = 0._wp ; zav_wave(:,jpj-nn_hls+1: jpj,:) = 0._wp 163 ENDIF 145 164 ! 146 165 ! ! ----------------------------- ! … … 150 169 ! !* Critical slope mixing: distribute energy over the time-varying ocean depth, 151 170 ! using an exponential decay from the seafloor. 152 DO_2D_ 11_11171 DO_2D_00_00 153 172 zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean 154 173 zfact(ji,jj) = rho0 * ( 1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) ) ) … … 156 175 END_2D 157 176 !!gm gde3w ==>>> check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 158 DO_3D_ 11_11( 2, jpkm1 )177 DO_3D_00_00( 2, jpkm1 ) 159 178 IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 160 179 zemx_iwm(ji,jj,jk) = 0._wp … … 176 195 CASE ( 1 ) ! Dissipation scales as N (recommended) 177 196 ! 178 zfact(:,:) = 0._wp 179 DO jk = 2, jpkm1 ! part independent of the level 180 zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 181 END DO 182 ! 183 DO_2D_11_11 197 DO_2D_00_00 198 zfact(ji,jj) = 0._wp 199 END_2D 200 DO_3D_00_00( 2, jpkm1 ) ! part independent of the level 201 zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 202 END_3D 203 ! 204 DO_2D_00_00 184 205 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 185 206 END_2D 186 207 ! 187 DO jk = 2, jpkm1! complete with the level-dependent part188 zemx_iwm( :,:,jk) = zemx_iwm(:,:,jk) + zfact(:,:) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk)189 END DO208 DO_3D_00_00( 2, jpkm1 ) ! complete with the level-dependent part 209 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 210 END_3D 190 211 ! 191 212 CASE ( 2 ) ! Dissipation scales as N^2 192 213 ! 193 zfact(:,:) = 0._wp 194 DO jk = 2, jpkm1 ! part independent of the level 195 zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 196 END DO 197 ! 198 DO_2D_11_11 214 DO_2D_00_00 215 zfact(ji,jj) = 0._wp 216 END_2D 217 DO_3D_00_00( 2, jpkm1 ) ! part independent of the level 218 zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 219 END_3D 220 ! 221 DO_2D_00_00 199 222 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 200 223 END_2D 201 224 ! 202 DO jk = 2, jpkm1! complete with the level-dependent part203 zemx_iwm( :,:,jk) = zemx_iwm(:,:,jk) + zfact(:,:) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk)204 END DO225 DO_3D_00_00( 2, jpkm1 ) ! complete with the level-dependent part 226 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 227 END_3D 205 228 ! 206 229 END SELECT … … 209 232 ! !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 210 233 ! 211 zwkb (:,:,:) = 0._wp 212 zfact(:,:) = 0._wp 213 DO jk = 2, jpkm1 214 zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 215 zwkb(:,:,jk) = zfact(:,:) 216 END DO 217 !!gm even better: 218 ! DO jk = 2, jpkm1 219 ! zwkb(:,:) = zwkb(:,:) + e3w(:,:,jk,Kmm) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) 220 ! END DO 221 ! zfact(:,:) = zwkb(:,:,jpkm1) 222 !!gm or just use zwkb(k=jpk-1) instead of zfact... 223 !!gm 224 ! 225 DO_3D_11_11( 2, jpkm1 ) 234 DO_2D_00_00 235 zwkb(ji,jj,1) = 0._wp 236 END_2D 237 DO_3D_00_00( 2, jpkm1 ) 238 zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 239 END_3D 240 DO_2D_00_00 241 zfact(ji,jj) = zwkb(ji,jj,jpkm1) 242 END_2D 243 ! 244 DO_3D_00_00( 2, jpkm1 ) 226 245 IF( zfact(ji,jj) /= 0 ) zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) ) & 227 246 & * wmask(ji,jj,jk) / zfact(ji,jj) 228 247 END_3D 229 zwkb(:,:,1) = zhdep(:,:) * wmask(:,:,1) 230 ! 231 DO_3D_11_11( 2, jpkm1 ) 232 IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 248 DO_2D_00_00 249 zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1) 250 END_2D 251 ! 252 DO_3D_00_00( 2, jpkm1 ) 253 IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization: EXP coast a lot 233 254 zweight(ji,jj,jk) = 0._wp 234 255 ELSE … … 238 259 END_3D 239 260 ! 240 zfact(:,:) = 0._wp 241 DO jk = 2, jpkm1 ! part independent of the level 242 zfact(:,:) = zfact(:,:) + zweight(:,:,jk) 243 END DO 244 ! 245 DO_2D_11_11 261 DO_2D_00_00 262 zfact(ji,jj) = 0._wp 263 END_2D 264 DO_3D_00_00( 2, jpkm1 ) ! part independent of the level 265 zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 266 END_3D 267 ! 268 DO_2D_00_00 246 269 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 247 270 END_2D 248 271 ! 249 DO jk = 2, jpkm1! complete with the level-dependent part250 zemx_iwm( :,:,jk) = zemx_iwm(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk) &251 & / ( gde3w(:,:,jk) - gde3w(:,:,jk-1) )252 !!gm use of e3t( :,:,:,Kmm) just above?253 END DO272 DO_3D_00_00( 2, jpkm1 ) ! complete with the level-dependent part 273 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk) & 274 & / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) ) 275 !!gm use of e3t(ji,jj,:,Kmm) just above? 276 END_3D 254 277 ! 255 278 !!gm this is to be replaced by just a constant value znu=1.e-6 m2/s 256 279 ! Calculate molecular kinematic viscosity 257 znu_t(:,:,:) = 1.e-4_wp * ( 17.91_wp - 0.53810_wp * ts(:,:,:,jp_tem,Kmm) + 0.00694_wp * ts(:,:,:,jp_tem,Kmm) * ts(:,:,:,jp_tem,Kmm) & 258 & + 0.02305_wp * ts(:,:,:,jp_sal,Kmm) ) * tmask(:,:,:) * r1_rho0 259 DO jk = 2, jpkm1 260 znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) 261 END DO 280 DO_3D_00_00( 1, jpkm1 ) 281 znu_t(ji,jj,jk) = 1.e-4_wp * ( 17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm) & 282 & + 0.00694_wp * ts(ji,jj,jk,jp_tem,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) & 283 & + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm) ) * tmask(ji,jj,jk) * r1_rho0 284 END_3D 285 DO_3D_00_00( 2, jpkm1 ) 286 znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 287 END_3D 262 288 !!gm end 263 289 ! 264 290 ! Calculate turbulence intensity parameter Reb 265 DO jk = 2, jpkm1266 zReb( :,:,jk) = zemx_iwm(:,:,jk) / MAX( 1.e-20_wp, znu_w(:,:,jk) * rn2(:,:,jk) )267 END DO291 DO_3D_00_00( 2, jpkm1 ) 292 zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 293 END_3D 268 294 ! 269 295 ! Define internal wave-induced diffusivity 270 DO jk = 2, jpkm1271 zav_wave( :,:,jk) = znu_w(:,:,jk) * zReb(:,:,jk) * r1_6 ! This corresponds to a constant mixing efficiency of 1/6272 END DO296 DO_3D_00_00( 2, jpkm1 ) 297 zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6 ! This corresponds to a constant mixing efficiency of 1/6 298 END_3D 273 299 ! 274 300 IF( ln_mevar ) THEN ! Variable mixing efficiency case : modify zav_wave in the 275 DO_3D_ 11_11( 2, jpkm1 )301 DO_3D_00_00( 2, jpkm1 ) 276 302 IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 277 303 zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) … … 282 308 ENDIF 283 309 ! 284 DO jk = 2, jpkm1! Bound diffusivity by molecular value and 100 cm2/s285 zav_wave( :,:,jk) = MIN( MAX( 1.4e-7_wp, zav_wave(:,:,jk) ), 1.e-2_wp ) * wmask(:,:,jk)286 END DO310 DO_3D_00_00( 2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s 311 zav_wave(ji,jj,jk) = MIN( MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp ) * wmask(ji,jj,jk) 312 END_3D 287 313 ! 288 314 IF( kt == nit000 ) THEN !* Control print at first time-step: diagnose the energy consumed by zav_wave 289 315 zztmp = 0._wp 290 316 !!gm used of glosum 3D.... 291 DO_3D_ 11_11( 2, jpkm1 )317 DO_3D_00_00( 2, jpkm1 ) 292 318 zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj) & 293 319 & * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) … … 311 337 IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature 312 338 ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 313 DO_3D_ 11_11( 2, jpkm1 )339 DO_3D_00_00( 2, jpkm1 ) 314 340 ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 315 341 IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN … … 320 346 END_3D 321 347 CALL iom_put( "av_ratio", zav_ratio ) 322 DO jk = 2, jpkm1!* update momentum & tracer diffusivity with wave-driven mixing323 p_avs( :,:,jk) = p_avs(:,:,jk) + zav_wave(:,:,jk) * zav_ratio(:,:,jk)324 p_avt( :,:,jk) = p_avt(:,:,jk) + zav_wave(:,:,jk)325 p_avm( :,:,jk) = p_avm(:,:,jk) + zav_wave(:,:,jk)326 END DO348 DO_3D_00_00( 2, jpkm1 ) !* update momentum & tracer diffusivity with wave-driven mixing 349 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 350 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 351 p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zav_wave(ji,jj,jk) 352 END_3D 327 353 ! 328 354 ELSE !* update momentum & tracer diffusivity with wave-driven mixing 329 DO jk = 2, jpkm1330 p_avs( :,:,jk) = p_avs(:,:,jk) + zav_wave(:,:,jk)331 p_avt( :,:,jk) = p_avt(:,:,jk) + zav_wave(:,:,jk)332 p_avm( :,:,jk) = p_avm(:,:,jk) + zav_wave(:,:,jk)333 END DO355 DO_3D_00_00( 2, jpkm1 ) 356 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) 357 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 358 p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zav_wave(ji,jj,jk) 359 END_3D 334 360 ENDIF 335 361 … … 341 367 IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN 342 368 ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) 343 z3d(:,:,:) = MAX( 0._wp, rn2(:,:,:) ) * zav_wave(:,:,:) 344 z2d(:,:) = 0._wp 345 DO jk = 2, jpkm1 346 z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk) 347 END DO 348 z2d(:,:) = rho0 * z2d(:,:) 349 CALL iom_put( "bflx_iwm", z3d ) 369 ! Initialisation for iom_put 370 DO_2D_00_00 371 z3d(ji,jj,1) = 0._wp ; z3d(ji,jj,jpk) = 0._wp 372 END_2D 373 z3d( 1:nn_hls,:,:) = 0._wp ; z3d(:, 1:nn_hls,:) = 0._wp 374 z3d(jpi-nn_hls+1:jpi ,:,:) = 0._wp ; z3d(:,jpj-nn_hls+1: jpj,:) = 0._wp 375 z2d( 1:nn_hls,: ) = 0._wp ; z2d(:, 1:nn_hls ) = 0._wp 376 z2d(jpi-nn_hls+1:jpi ,: ) = 0._wp ; z2d(:,jpj-nn_hls+1: jpj ) = 0._wp 377 378 DO_3D_00_00( 2, jpkm1 ) 379 z3d(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) 380 END_3D 381 DO_2D_00_00 382 z2d(ji,jj) = 0._wp 383 END_2D 384 DO_3D_00_00( 2, jpkm1 ) 385 z2d(ji,jj) = z2d(ji,jj) + e3w(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * wmask(ji,jj,jk) 386 END_3D 387 DO_2D_00_00 388 z2d(ji,jj) = rho0 * z2d(ji,jj) 389 END_2D 390 CALL iom_put( "bflx_iwm", z3d ) 350 391 CALL iom_put( "pcmap_iwm", z2d ) 351 392 DEALLOCATE( z2d , z3d ) -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OFF/dtadyn.F90
r12866 r12962 65 65 INTEGER , SAVE :: jf_uwd ! index of u-transport 66 66 INTEGER , SAVE :: jf_vwd ! index of v-transport 67 INTEGER , SAVE :: jf_wwd ! index of v-transport67 INTEGER , SAVE :: jf_wwd ! index of w-transport 68 68 INTEGER , SAVE :: jf_avt ! index of Kz 69 69 INTEGER , SAVE :: jf_mld ! index of mixed layer deptht … … 283 283 ! ! fill sf with slf_i and control print 284 284 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 285 sf_dyn(jf_uwd)%cltype = 'U' ; sf_dyn(jf_uwd)%zsgn = -1._wp 286 sf_dyn(jf_vwd)%cltype = 'V' ; sf_dyn(jf_vwd)%zsgn = -1._wp 287 sf_dyn(jf_ubl)%cltype = 'U' ; sf_dyn(jf_ubl)%zsgn = 1._wp 288 sf_dyn(jf_vbl)%cltype = 'V' ; sf_dyn(jf_vbl)%zsgn = 1._wp 285 289 ! 286 290 ! Open file for each variable to get his number of dimension -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OFF/nemogcm.F90
r12958 r12962 278 278 ! 279 279 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 280 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )280 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 281 281 ELSE ! user-defined namelist 282 CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )282 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 283 283 ENDIF 284 284 ! -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/SAO/nemogcm.F90
r12958 r12962 207 207 ! 208 208 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 209 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )209 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 210 210 ELSE ! user-defined namelist 211 CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )211 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 212 212 ENDIF 213 213 ! -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/SAS/nemogcm.F90
r12958 r12962 329 329 ! 330 330 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 331 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )331 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 332 332 ELSE ! user-defined namelist 333 CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )333 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 334 334 ENDIF 335 335 ! -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/SAS/sbcssm.F90
r12958 r12962 290 290 ! ! fill sf with slf_i and control print 291 291 CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' ) 292 sf_ssm_3d(jf_usp)%cltype = 'U' ; sf_ssm_3d(jf_usp)%zsgn = -1._wp 293 sf_ssm_3d(jf_vsp)%cltype = 'V' ; sf_ssm_3d(jf_vsp)%zsgn = -1._wp 292 294 ENDIF 293 295 ! … … 306 308 ! 307 309 CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' ) 310 IF( .NOT. ln_3d_uve ) THEN 311 sf_ssm_2d(jf_usp)%cltype = 'U' ; sf_ssm_2d(jf_usp)%zsgn = -1._wp 312 sf_ssm_2d(jf_vsp)%cltype = 'V' ; sf_ssm_2d(jf_vsp)%zsgn = -1._wp 313 ENDIF 308 314 ENDIF 309 315 ! -
NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/TOP/trcini.F90
r12377 r12962 93 93 INTEGER :: jk, jn ! dummy loop indices 94 94 CHARACTER (len=25) :: charout 95 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: zzmsk 96 CHARACTER (len=25), DIMENSION(jptra) :: clseb 95 97 !!---------------------------------------------------------------------- 96 98 ! … … 128 130 CALL prt_ctl_trc_info( charout ) 129 131 CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 132 DO jn = 1, jptra 133 zzmsk(:,:,:,jn) = tmask(:,:,:) 134 WRITE(clseb(jn),'(a,i2.2)') 'seb ', jn 135 END DO 136 CALL prt_ctl_trc( tab4d=zzmsk, mask=tmask, clinfo=clseb ) 130 137 ENDIF 131 138 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10)
Note: See TracChangeset
for help on using the changeset viewer.
