Changeset 10492 for branches/UKMO
- Timestamp:
- 2019-01-10T10:32:21+01:00 (5 years ago)
- Location:
- branches/UKMO/CO6_shelfclimate_fabm_noos/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 3 edited
-
diaar5.F90 (modified) (1 diff)
-
diadct.F90 (modified) (29 diffs)
-
diaregmean.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/CO6_shelfclimate_fabm_noos/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r7572 r10492 205 205 zbotpres_mat(:,:) = zbotpres(:,:) 206 206 CALL iom_put( 'botpres', zbotpres_mat ) 207 207 208 208 ! ! Mean density anomalie, temperature and salinity 209 209 ztemp = 0._wp -
branches/UKMO/CO6_shelfclimate_fabm_noos/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r7613 r10492 1 1 MODULE diadct 2 2 3 !!===================================================================== 3 4 !! *** MODULE diadct *** … … 69 70 LOGICAL, PUBLIC :: ln_dct_calc_noos_25h !: Calcuate noos 25 h means 70 71 LOGICAL, PUBLIC :: ln_dct_calc_noos_hr !: Calcuate noos hourly means 72 ! JT 73 LOGICAL, PUBLIC :: ln_dct_iom_cont !: Use IOM Output? 74 LOGICAL, PUBLIC :: ln_dct_ascii !: Output ascii or binary 75 LOGICAL, PUBLIC :: ln_dct_h !: Output hourly instantaneous or mean values 76 ! JT 71 77 72 78 !! * Module variables … … 74 80 INTEGER :: nn_dctwri ! Frequency of output 75 81 INTEGER :: nn_secdebug ! Number of the section to debug 76 INTEGER :: nn_dct_h = 1 ! Frequency of computation for NOOS hourly files 77 INTEGER :: nn_dctwri_h = 1 ! Frequency of output for NOOS hourly files 82 ! INTEGER :: nn_dct_h = 1 ! Frequency of computation for NOOS hourly files 83 INTEGER :: nn_dct_h ! Frequency of computation for NOOS hourly files 84 INTEGER :: nn_dctwri_h ! Frequency of output for NOOS hourly files 78 85 79 86 INTEGER, PARAMETER :: nb_class_max = 11 ! maximum number of classes, i.e. depth levels or density classes 80 INTEGER, PARAMETER :: nb_sec_max = 30 ! maximum number of sections 81 INTEGER, PARAMETER :: nb_point_max = 375 ! maximum number of points in a single section 87 ! JT INTEGER, PARAMETER :: nb_sec_max = 30 ! maximum number of sections 88 INTEGER, PARAMETER :: nb_sec_max = 80 !50 maximum number of sections 89 INTEGER, PARAMETER :: nb_point_max = 150 !375 maximum number of points in a single section 90 91 92 82 93 INTEGER, PARAMETER :: nb_type = 14 ! types of calculations, i.e. pos transport, neg transport, heat transport, salt transport 83 94 INTEGER, PARAMETER :: nb_3d_vars = 5 … … 133 144 !!---------------------------------------------------------------------- 134 145 ! 146 147 !JT not sure why this is in nemogcm.F90(?) rather than diadct_init... 148 !JT it would be good if the nb_sec_max and nb_point_max were controlled by name list variable. 149 150 135 151 ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(1) ) 136 152 ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=ierr(2) ) 137 153 ALLOCATE(transports_3d_h(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(3) ) 138 154 ALLOCATE(transports_2d_h(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=ierr(4) ) 139 ALLOCATE(z_hr_output(nb_sec_max,24,nb_class_max) , STAT=ierr(5) ) 140 ! 155 !JT ALLOCATE(z_hr_output(nb_sec_max,24,nb_class_max) , STAT=ierr(5) ) 156 ALLOCATE(z_hr_output(nb_sec_max,3,nb_class_max) , STAT=ierr(5) ) 157 141 158 diadct_alloc = MAXVAL( ierr ) 142 159 IF( diadct_alloc /= 0 ) CALL ctl_warn('diadct_alloc: failed to allocate arrays') … … 153 170 !! 154 171 !!--------------------------------------------------------------------- 155 NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug,ln_dct_calc_noos_25h,ln_dct_calc_noos_hr 156 INTEGER :: ios ! Local integer output status for namelist read 172 !JT NAMELIST/namdct/nn_dct,ln_dct_h,nn_dctwri,ln_dct_ascii,nn_secdebug,ln_dct_calc_noos_25h,ln_dct_calc_noos_hr,ln_dct_iom_cont,nb_sec_max,nb_point_max 173 NAMELIST/namdct/nn_dct,ln_dct_h,nn_dctwri,ln_dct_ascii,nn_secdebug,ln_dct_calc_noos_25h,ln_dct_calc_noos_hr,ln_dct_iom_cont 174 INTEGER :: ios,jsec ! Local integer output status for namelist read 175 CHARACTER(len=3) :: jsec_str ! name of the jsec 157 176 158 177 IF( nn_timing == 1 ) CALL timing_start('dia_dct_init') … … 167 186 IF(lwm) WRITE ( numond, namdct ) 168 187 169 170 171 172 173 174 175 176 188 177 189 IF( ln_NOOS ) THEN 178 nn_dct=3600./rdt ! hard coded for NOOS transects, to give 25 hour means 190 191 !Do calculation for daily, 25hourly mean every hour 192 nn_dct=3600./rdt ! hard coded for NOOS transects, to give 25 hour means from hourly instantaneous values 193 194 !write out daily, 25hourly mean every day 179 195 nn_dctwri=86400./rdt 196 197 198 ! JT 199 ! 200 ! 201 !nn_dct_h=1 ! hard coded for NOOS transects, to give hourly data 202 ! If you want hourly instantaneous values, you only do the calculation every 12 timesteps (if rdt = 300) 203 ! and output it every 12 time steps. For this, you set the ln_dct_h to be True, and it calcuates it automatically 204 ! if you want hourly mean values, set ln_dct_h to be False, and it will do the calculate every time step. 205 ! 206 !SELECT CASE( ln_dct_h ) 207 ! CASE(.TRUE.) 208 ! nn_dct_h=3600./rdt 209 ! CASE(.FALSE.) 210 ! nn_dct_h=1 211 !END SELECT 180 212 181 nn_dct_h=1 ! hard coded for NOOS transects, to give hourly data 213 IF ( ln_dct_h ) THEN 214 nn_dct_h=3600./rdt 215 ELSE 216 nn_dct_h=1. 217 ENDIF 218 219 !JT write out hourly calculation every hour 182 220 nn_dctwri_h=3600./rdt 183 221 ENDIF … … 190 228 WRITE(numout,*) " Calculate NOOS hourly output: ln_dct_calc_noos_hr = ",ln_dct_calc_noos_hr 191 229 WRITE(numout,*) " Calculate NOOS 25 hour mean output: ln_dct_calc_noos_hr = ",ln_dct_calc_noos_25h 230 WRITE(numout,*) " Use IOM Output: ln_dct_iom_cont = ",ln_dct_iom_cont 231 WRITE(numout,*) " Output in ASCII (True) or Binary (False): ln_dct_ascii = ",ln_dct_ascii 232 WRITE(numout,*) " Frequency of hourly computation - instantaneous (TRUE) or hourly mean (FALSE): ln_dct_h = ",ln_dct_h 233 192 234 WRITE(numout,*) " Frequency of computation hard coded to be every hour: nn_dct = ",nn_dct 193 235 WRITE(numout,*) " Frequency of write hard coded to average 25 instantaneous hour values: nn_dctwri = ",nn_dctwri 194 WRITE(numout,*) " Frequency of hourly computation hard coded to be every timestep: nn_dct_h = ",nn_dct_h 236 WRITE(numout,*) " Frequency of hourly computation (timestep) : nn_dct_h = ",nn_dct_h 237 WRITE(numout,*) " Frequency of hourly computation Not hard coded to be every timestep, or : nn_dct_h = ",nn_dct_h 195 238 WRITE(numout,*) " Frequency of hourly write hard coded to every hour: nn_dctwri_h = ",nn_dctwri_h 196 239 ELSE … … 215 258 IF ( ln_dct_calc_noos_25h .or. ln_dct_calc_noos_hr ) CALL readsec 216 259 ENDIF 217 218 260 219 261 !open output file 220 262 IF( lwp ) THEN 221 263 IF( ln_NOOS ) THEN 222 if ( ln_dct_calc_noos_25h ) CALL ctl_opn( numdct_NOOS ,'NOOS_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 223 if ( ln_dct_calc_noos_hr ) CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_h', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 264 WRITE(numout,*) "diadct_init: Open output files. ASCII? ",ln_dct_ascii 265 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 266 IF ( ln_dct_ascii ) THEN 267 if ( ln_dct_calc_noos_25h ) CALL ctl_opn( numdct_NOOS ,'NOOS_transport' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 268 if ( ln_dct_calc_noos_hr ) CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_h', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 269 ELSE 270 if ( ln_dct_calc_noos_25h ) CALL ctl_opn( numdct_NOOS ,'NOOS_transport_bin' , 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 271 if ( ln_dct_calc_noos_hr ) CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_bin_h', 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 272 ENDIF 224 273 ELSE 225 274 CALL ctl_opn( numdct_vol , 'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) … … 230 279 231 280 ! Initialise arrays to zero 232 transports_3d(:,:,:,:) =0._wp233 transports_2d(:,:,:) =0._wp234 transports_3d_h(:,:,:,:) =0._wp235 transports_2d_h(:,:,:) =0._wp236 z_hr_output(:,:,:) =0._wp281 transports_3d(:,:,:,:) =0._wp 282 transports_2d(:,:,:) =0._wp 283 transports_3d_h(:,:,:,:) =0._wp 284 transports_2d_h(:,:,:) =0._wp 285 z_hr_output(:,:,:) =0._wp 237 286 238 287 IF( nn_timing == 1 ) CALL timing_stop('dia_dct_init') 288 289 IF (ln_dct_iom_cont) THEN 290 IF( lwp ) THEN 291 WRITE(numout,*) " " 292 WRITE(numout,*) "diadct_init: using xios iom_put for output: field_def.xml and iodef.xml code" 293 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 294 WRITE(numout,*) "" 295 WRITE(numout,*) " field_def.xml" 296 WRITE(numout,*) " ~~~~~~~~~~~~~" 297 WRITE(numout,*) "" 298 WRITE(numout,*) "" 299 300 WRITE(numout,*) ' <field_group id="noos_cross_section" domain_ref="1point" axis_ref="noos" operation="average">' 301 302 DO jsec=1,nb_sec 303 WRITE (jsec_str, "(I3.3)") jsec 304 305 WRITE(numout,*) ' <field id="noos_'//jsec_str//'_trans" long_name="' // TRIM(secs(jsec)%name) // ' 25h mean NOOS transport cross-section number: '//jsec_str//' (total, positive, negative)" unit="m^3/s" />' 306 WRITE(numout,*) ' <field id="noos_'//jsec_str//'_heat" long_name="' // TRIM(secs(jsec)%name) // ' 25h mean NOOS heat cross-section number: '//jsec_str//' (total, positive, negative)" unit="J/s" />' 307 WRITE(numout,*) ' <field id="noos_'//jsec_str//'_salt" long_name="' // TRIM(secs(jsec)%name) // ' 25h mean NOOS salt cross-section number: '//jsec_str//' (total, positive, negative)" unit="g/s" />' 308 309 ENDDO 310 311 WRITE(numout,*) ' </field_group>' 312 313 WRITE(numout,*) "" 314 WRITE(numout,*) "" 315 WRITE(numout,*) " iodef.xml" 316 WRITE(numout,*) " ~~~~~~~~~" 317 WRITE(numout,*) "" 318 WRITE(numout,*) "" 319 320 WRITE(numout,*) ' <file_group id="1d" output_freq="1d" output_level="10" enabled=".TRUE.">' 321 WRITE(numout,*) "" 322 WRITE(numout,*) ' <file id="noos_cross_section" name="NOOS_transport">' 323 DO jsec=1,nb_sec 324 WRITE (jsec_str, "(I3.3)") jsec 325 326 WRITE(numout,*) ' <field field_ref="noos_'//jsec_str//'_trans" />' 327 WRITE(numout,*) ' <field field_ref="noos_'//jsec_str//'_heat" />' 328 WRITE(numout,*) ' <field field_ref="noos_'//jsec_str//'_salt" />' 329 330 ENDDO 331 WRITE(numout,*) ' </file>' 332 WRITE(numout,*) "" 333 WRITE(numout,*) ' </file_group>' 334 335 WRITE(numout,*) "" 336 WRITE(numout,*) "" 337 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 338 WRITE(numout,*) "" 339 340 ENDIF 341 ENDIF 342 343 239 344 ! 240 345 END SUBROUTINE dia_dct_init … … 274 379 275 380 276 277 !i_steps = 1278 279 280 381 281 382 IF( nn_timing == 1 ) CALL timing_start('dia_dct') 282 383 283 IF( lk_mpp ) THEN384 IF( lk_mpp ) THEN 284 385 itotal = nb_sec_max*nb_type*nb_class_max 285 386 CALL wrk_alloc( itotal , zwork ) … … 328 429 329 430 330 IF( lwp .AND. kt==nit000+nn_dctwri-1 )WRITE(numout,*)" diadct: average and write at kt = ",kt 331 332 !! divide arrays by nn_dctwri/nn_dct to obtain average 333 transports_3d(:,:,:,:)=transports_3d(:,:,:,:)/(nn_dctwri/nn_dct) 334 transports_2d(:,:,:) =transports_2d(:,:,:) /(nn_dctwri/nn_dct) 431 IF( lwp .AND. kt==nit000+nn_dctwri-1 ) WRITE(numout,*)" diadct: average and write at kt = ",kt 432 433 434 !JT 435 !JT 436 !JT !! divide arrays by nn_dctwri/nn_dct to obtain average 437 !JT transports_3d(:,:,:,:)=transports_3d(:,:,:,:)/(nn_dctwri/nn_dct) 438 !JT transports_2d(:,:,:) =transports_2d(:,:,:) /(nn_dctwri/nn_dct) 439 !JT 440 !JT 441 442 443 !JT 444 !JT Not 24 values, but 25! divide by ((nn_dctwri/nn_dct) +1) 445 !! divide arrays by nn_dctwri/nn_dct to obtain average 446 transports_3d(:,:,:,:)= transports_3d(:,:,:,:)/((nn_dctwri/nn_dct)+1.) 447 transports_2d(:,:,:) = transports_2d(:,:,:) /((nn_dctwri/nn_dct)+1.) 335 448 336 449 ! Sum over each class … … 394 507 395 508 !! divide arrays by nn_dctwri/nn_dct to obtain average 509 ! 510 ! JT - I think this is wrong. I think it is trying to sum over 25 hours, but only dividing by 24. 511 ! I think it might work for daily cycles, but not for monthly cycles, 512 ! 396 513 transports_3d_h(:,:,:,:)=transports_3d_h(:,:,:,:)/(nn_dctwri_h/nn_dct_h) 397 514 transports_2d_h(:,:,:) =transports_2d_h(:,:,:) /(nn_dctwri_h/nn_dct_h) … … 422 539 transports_3d_h(:,jsec,:,:)=0.0 423 540 transports_2d_h(:,jsec,:)=0.0 424 secs(jsec)%transport_h(:,:)=0. 425 IF ( ln_NOOS ) CALL transport_h(secs(jsec),lldebug,jsec) ! reinitialise for next 25 hour instantaneous average (overlapping values) 541 secs(jsec)%transport_h(:,:)=0.0 542 543 ! for hourly mean or hourly instantaneous, you don't initialise! start with zero! 544 !IF ( ln_NOOS ) CALL transport_h(secs(jsec),lldebug,jsec) ! reinitialise for next 25 hour instantaneous average (overlapping values) 426 545 427 546 ENDDO … … 674 793 675 794 nb_sec = jsec-1 !number of section read in the file 795 796 IF( lwp ) WRITE(numout,*)'diadct: read sections: Finished readsec.' 676 797 677 798 CALL wrk_dealloc( nb_point_max, directemp ) … … 801 922 ! COMPUTE TRANSPORT ! 802 923 !---------------------------! 803 IF(sec%nb_point .NE. 0)THEN 804 924 IF(sec%nb_point .NE. 0)THEN 925 926 !---------------------------------------------------------------------------------------------------- 927 !---------------------------------------------------------------------------------------------------- 928 !---------------------------------------------------------------------------------------------------- 929 ! 930 ! 931 ! ! ! ! JT 1/09/2018 - changing convention. Always direction + is toward left hand of section 932 ! 933 ! Making sign of the velocities used to calculate the volume transport a function of direction, not slopesection 934 ! (isgnu, isgnv) 935 ! 936 ! They vary for each segment of the section. 937 ! 938 !---------------------------------------------------------------------------------------------------- 939 !---------------------------------------------------------------------------------------------------- 805 940 !---------------------------------------------------------------------------------------------------- 806 941 !Compute sign for velocities: … … 824 959 ! 825 960 !---------------------------------------------------------------------------------------------------- 826 isgnu = 1827 IF( sec%slopeSection .GT. 0 ) THEN ; isgnv = -1828 ELSE ; isgnv = 1829 ENDIF830 IF( sec%slopeSection .GE. 9999. ) isgnv = 1961 ! JT isgnu = 1 962 ! JT IF( sec%slopeSection .GT. 0 ) THEN ; isgnv = -1 963 ! JT ELSE ; isgnv = 1 964 ! JT ENDIF 965 ! JT IF( sec%slopeSection .GE. 9999. ) isgnv = 1 831 966 832 967 IF( ld_debug )write(numout,*)"sec%slopeSection isgnu isgnv ",sec%slopeSection,isgnu,isgnv … … 836 971 !--------------------------------------! 837 972 DO jseg=1,MAX(sec%nb_point-1,0) 838 973 974 975 !JT: Compute sign for velocities: 976 977 !isgnu = 1 978 !isgnv = 1 979 ! 980 ! JT changing sign of u and v is dependent on the direction of the section. 981 !isgnu = 1 982 !isgnv = 1 983 !SELECT CASE( sec%direction(jseg) ) 984 !CASE(0) ; isgnv = -1 985 !CASE(3) ; isgnu = -1 986 !END SELECT 987 988 989 SELECT CASE( sec%direction(jseg) ) 990 CASE(0) 991 isgnu = 1 992 isgnv = -1 993 CASE(1) 994 isgnu = 1 995 isgnv = 1 996 CASE(2) 997 isgnu = 1 998 isgnv = 1 999 CASE(3) 1000 isgnu = -1 1001 isgnv = 1 1002 END SELECT 1003 839 1004 !------------------------------------------------------------------------------------------- 840 1005 ! Select the appropriate coordinate for computing the velocity of the segment 1006 ! Corrected by JT 01/09/2018 (#) 841 1007 ! 842 1008 ! CASE(0) Case (2) 843 1009 ! ------- -------- 844 1010 ! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j) 845 ! F(i,j)--------- -V(i+1,j)-------F(i+1,j)|846 ! 847 ! 848 ! 849 ! Case (3) 850 ! -------- 851 ! 1011 ! F(i,j)---------#V(i,j)-------F(i+1,j) | 1012 ! --------> | 1013 ! | | 1014 ! | | 1015 ! Case (3) | U(i,j) 1016 ! -------- | | 1017 ! V | 852 1018 ! listPoint(jseg+1) F(i,j+1) | 853 1019 ! | | 854 1020 ! | | 855 1021 ! | listPoint(jseg+1) F(i,j-1) 856 ! 857 ! 858 ! 859 ! 860 ! 1022 ! ^ | 1023 ! | | 1024 ! | U(i,j+1) 1025 ! | | Case(1) 1026 ! | | ------ 861 1027 ! | 862 1028 ! | listPoint(jseg+1) listPoint(jseg) 863 ! | F(i-1,j)---------- -V(i,j) -------f(jseg)864 ! listPoint(jseg) F(i,j) 1029 ! | F(i-1,j)----------#V(i-1,j) ------#f(i,j) 1030 ! listPoint(jseg) F(i,j) <------- 865 1031 ! 866 1032 !------------------------------------------------------------------------------------------- … … 878 1044 !Sum of the transport on the vertical 879 1045 DO jk=1,mbathy(k%I,k%J) 880 881 ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 1046 1047 ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 882 1048 SELECT CASE( sec%direction(jseg) ) 883 1049 CASE(0,1) … … 1016 1182 ! COMPUTE TRANSPORT ! 1017 1183 !---------------------------! 1018 IF(sec%nb_point .NE. 0)THEN 1019 1184 IF(sec%nb_point .NE. 0)THEN 1185 1186 !---------------------------------------------------------------------------------------------------- 1187 !---------------------------------------------------------------------------------------------------- 1188 !---------------------------------------------------------------------------------------------------- 1189 ! 1190 ! 1191 ! ! ! ! JT 1/09/2018 - changing convention. Always direction + is toward left hand of section 1192 ! 1193 ! Making sign of the velocities used to calculate the volume transport a function of direction, not slopesection 1194 ! (isgnu, isgnv) 1195 ! 1196 ! They vary for each segment of the section. 1197 ! 1198 !---------------------------------------------------------------------------------------------------- 1199 !---------------------------------------------------------------------------------------------------- 1020 1200 !---------------------------------------------------------------------------------------------------- 1021 1201 !Compute sign for velocities: … … 1039 1219 ! 1040 1220 !---------------------------------------------------------------------------------------------------- 1041 isgnu = 1 1042 IF( sec%slopeSection .GT. 0 ) THEN ; isgnv = -1 1043 ELSE ; isgnv = 1 1044 ENDIF 1221 ! JT isgnu = 1 1222 ! JT IF( sec%slopeSection .GT. 0 ) THEN ; isgnv = -1 1223 ! JT ELSE ; isgnv = 1 1224 ! JT ENDIF 1225 ! JT IF( sec%slopeSection .GE. 9999. ) isgnv = 1 1045 1226 1046 1227 IF( ld_debug )write(numout,*)"isgnu isgnv ",isgnu,isgnv … … 1050 1231 !--------------------------------------! 1051 1232 DO jseg=1,MAX(sec%nb_point-1,0) 1052 1233 1234 1235 !JT: Compute sign for velocities: 1236 1237 !isgnu = 1 1238 !isgnv = 1 1239 ! 1240 ! JT changing sign of u and v is dependent on the direction of the section. 1241 !isgnu = 1 1242 !isgnv = 1 1243 !SELECT CASE( sec%direction(jseg) ) 1244 !CASE(0) ; isgnv = -1 1245 !CASE(3) ; isgnu = -1 1246 !END SELECT 1247 1248 1249 SELECT CASE( sec%direction(jseg) ) 1250 CASE(0) 1251 isgnu = 1 1252 isgnv = -1 1253 CASE(1) 1254 isgnu = 1 1255 isgnv = 1 1256 CASE(2) 1257 isgnu = 1 1258 isgnv = 1 1259 CASE(3) 1260 isgnu = -1 1261 isgnv = 1 1262 END SELECT 1263 1053 1264 !------------------------------------------------------------------------------------------- 1054 1265 ! Select the appropriate coordinate for computing the velocity of the segment 1266 ! Corrected by JT 01/09/2018 (#) 1055 1267 ! 1056 1268 ! CASE(0) Case (2) 1057 1269 ! ------- -------- 1058 1270 ! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j) 1059 ! F(i,j)--------- -V(i+1,j)-------F(i+1,j)|1060 ! 1061 ! 1062 ! 1063 ! Case (3) 1064 ! -------- 1065 ! 1271 ! F(i,j)---------#V(i,j)-------F(i+1,j) | 1272 ! --------> | 1273 ! | | 1274 ! | | 1275 ! Case (3) | U(i,j) 1276 ! -------- | | 1277 ! V | 1066 1278 ! listPoint(jseg+1) F(i,j+1) | 1067 1279 ! | | 1068 1280 ! | | 1069 1281 ! | listPoint(jseg+1) F(i,j-1) 1070 ! 1071 ! 1072 ! 1073 ! 1074 ! 1282 ! ^ | 1283 ! | | 1284 ! | U(i,j+1) 1285 ! | | Case(1) 1286 ! | | ------ 1075 1287 ! | 1076 1288 ! | listPoint(jseg+1) listPoint(jseg) 1077 ! | F(i-1,j)---------- -V(i,j) -------f(jseg)1078 ! listPoint(jseg) F(i,j) 1289 ! | F(i-1,j)----------#V(i-1,j) ------#f(i,j) 1290 ! listPoint(jseg) F(i,j) <------- 1079 1291 ! 1080 1292 !------------------------------------------------------------------------------------------- … … 1093 1305 DO jk=1,mbathy(k%I,k%J) 1094 1306 1095 ! compute temp arature, salinity, insitu & potential density, ssh and depth at U/V point1307 ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 1096 1308 SELECT CASE( sec%direction(jseg) ) 1097 1309 CASE(0,1) … … 1649 1861 INTEGER :: IERR 1650 1862 1863 REAL(wp), DIMENSION(3) :: tmp_iom_output 1864 REAL(wp) :: max_iom_val 1865 1651 1866 !!------------------------------------------------------------- 1867 1652 1868 1653 1869 … … 1662 1878 zsumclasses(:)=0._wp 1663 1879 zslope = sec%slopeSection 1664 1880 1665 1881 IF( lwp ) THEN 1666 WRITE(numdct_NOOS,'(I4,a1,I2,a1,I2,a12,i3,a17,i3,a10,a25)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1,' Name: ',sec%name 1667 ENDIF 1882 IF ( ln_dct_ascii ) THEN 1883 WRITE(numdct_NOOS,'(I4,a1,I2,a1,I2,a12,i3,a17,i3,a10,a25)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1,' Name: ',sec%name 1884 ELSE 1885 WRITE(numdct_NOOS) nyear,nmonth,nday,ksec-1,sec%nb_class-1,sec%name 1886 ENDIF 1887 ENDIF 1888 1889 ! Sum all classes together, to give one values per type (pos tran, neg vol trans etc...). 1668 1890 DO jclass=1,MAX(1,sec%nb_class-1) 1669 1891 zsumclasses(1:nb_type)=zsumclasses(1:nb_type)+sec%transport(1:nb_type,jclass) … … 1678 1900 write (noos_sect_name, "(I0.3)") ksec 1679 1901 1680 ALLOCATE( noos_iom_dummy(jpi,jpj,3), STAT= ierr ) 1681 IF( ierr /= 0 ) CALL ctl_stop( 'dia_dct_wri_NOOS: failed to allocate noos_iom_dummy array' ) 1902 IF ( ln_dct_iom_cont ) THEN 1903 max_iom_val = 1.e10 1904 ALLOCATE( noos_iom_dummy(jpi,jpj,3), STAT= ierr ) 1905 IF( ierr /= 0 ) CALL ctl_stop( 'dia_dct_wri_NOOS: failed to allocate noos_iom_dummy array' ) 1906 ENDIF 1907 1908 ! JT 1909 ! JT 1910 ! JT 1911 ! JT I think changing the sign on the output based on the zslope value is redunant. 1912 ! JT 1913 ! JT 1914 ! JT 1915 ! JT 1916 ! JT 1917 ! 1918 ! 1919 ! 1920 ! IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1921 ! 1922 ! IF( lwp ) THEN 1923 ! WRITE(numdct_NOOS,'(9e12.4E2)') -(zsumclasses( 1)+zsumclasses( 2)), -zsumclasses( 2),-zsumclasses( 1), & 1924 ! -(zsumclasses( 7)+zsumclasses( 8)), -zsumclasses( 8),-zsumclasses( 7), & 1925 ! -(zsumclasses( 9)+zsumclasses(10)), -zsumclasses(10),-zsumclasses( 9) 1926 ! CALL FLUSH(numdct_NOOS) 1927 ! endif 1928 1929 ! 1930 ! IF ( ln_dct_iom_cont ) THEN 1931 ! 1932 ! noos_iom_dummy(:,:,:) = 0. 1933 ! 1934 ! tmp_iom_output(:) = 0. 1935 ! tmp_iom_output(1) = -(zsumclasses( 1)+zsumclasses( 2)) 1936 ! tmp_iom_output(2) = -zsumclasses( 2) 1937 ! tmp_iom_output(3) = -zsumclasses( 1) 1938 ! 1939 ! ! Convert to Sv 1940 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 1941 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 1942 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 1943 ! 1944 ! ! limit maximum and minimum values in iom_put 1945 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 1946 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 1947 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 1948 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 1949 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 1950 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 1951 ! 1952 ! ! Set NaN's to Zero 1953 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 1954 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 1955 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 1956 ! 1957 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 1958 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 1959 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 1960 ! 1961 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_trans' 1962 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1963 ! CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 1964 ! noos_iom_dummy(:,:,:) = 0. 1965 ! tmp_iom_output(:) = 0. 1966 ! tmp_iom_output(1) = -(zsumclasses( 7)+zsumclasses( 8)) 1967 ! tmp_iom_output(2) = -zsumclasses( 8) 1968 ! tmp_iom_output(3) = -zsumclasses( 7) 1969 ! 1970 ! ! Convert to TJ/s 1971 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-12 1972 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-12 1973 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-12 1974 ! 1975 ! ! limit maximum and minimum values in iom_put 1976 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 1977 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 1978 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 1979 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 1980 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 1981 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 1982 ! 1983 ! ! Set NaN's to Zero 1984 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 1985 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 1986 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 1987 ! 1988 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 1989 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 1990 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 1991 ! 1992 ! !noos_iom_dummy(:,:,1) = -(zsumclasses( 7)+zsumclasses( 8)) 1993 ! !noos_iom_dummy(:,:,2) = -zsumclasses( 8) 1994 ! !noos_iom_dummy(:,:,3) = -zsumclasses( 7) 1995 ! 1996 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_heat' 1997 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1998 ! CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 1999 ! 2000 ! noos_iom_dummy(:,:,:) = 0. 2001 ! tmp_iom_output(:) = 0. 2002 ! tmp_iom_output(1) = -(zsumclasses( 9)+zsumclasses( 10)) 2003 ! tmp_iom_output(2) = -zsumclasses( 10) 2004 ! tmp_iom_output(3) = -zsumclasses( 9) 2005 ! 2006 ! ! Convert to MT/s 2007 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 2008 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 2009 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 2010 ! 2011 ! ! limit maximum and minimum values in iom_put 2012 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2013 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2014 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2015 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2016 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2017 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2018 ! 2019 ! ! Set NaN's to Zero 2020 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2021 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2022 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2023 ! 2024 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2025 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2026 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2027 ! 2028 ! !noos_iom_dummy(:,:,1) = -(zsumclasses( 9)+zsumclasses( 10)) 2029 ! !noos_iom_dummy(:,:,2) = -zsumclasses( 10) 2030 ! !noos_iom_dummy(:,:,3) = -zsumclasses( 9) 2031 ! 2032 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_salt' 2033 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 2034 ! CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 2035 ! noos_iom_dummy(:,:,:) = 0. 2036 ! tmp_iom_output(:) = 0. 2037 ! ENDIF 2038 ! ELSE 2039 ! IF( lwp ) THEN 2040 ! WRITE(numdct_NOOS,'(9e12.4E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 2041 ! zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), & 2042 ! zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10) 2043 ! CALL FLUSH(numdct_NOOS) 2044 ! endif 2045 ! 2046 ! 2047 ! IF ( ln_dct_iom_cont ) THEN 2048 ! 2049 ! noos_iom_dummy(:,:,:) = 0. 2050 ! tmp_iom_output(:) = 0. 2051 ! 2052 ! tmp_iom_output(1) = (zsumclasses( 1)+zsumclasses( 2)) 2053 ! tmp_iom_output(2) = zsumclasses( 1) 2054 ! tmp_iom_output(3) = zsumclasses( 2) 2055 ! 2056 ! ! Convert to Sv 2057 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 2058 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 2059 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 2060 ! 2061 ! ! limit maximum and minimum values in iom_put 2062 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2063 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2064 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2065 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2066 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2067 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2068 ! 2069 ! ! Set NaN's to Zero 2070 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2071 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2072 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2073 ! 2074 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2075 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2076 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2077 ! 2078 ! !noos_iom_dummy(:,:,1) = (zsumclasses( 1)+zsumclasses( 2)) 2079 ! !noos_iom_dummy(:,:,2) = zsumclasses( 1) 2080 ! !noos_iom_dummy(:,:,3) = zsumclasses( 2) 2081 ! 2082 ! 2083 ! 2084 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_trans' 2085 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 2086 ! CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 2087 ! noos_iom_dummy(:,:,:) = 0. 2088 ! tmp_iom_output(:) = 0. 2089 ! 2090 ! tmp_iom_output(1) = (zsumclasses( 7)+zsumclasses( 8)) 2091 ! tmp_iom_output(2) = zsumclasses( 7) 2092 ! tmp_iom_output(3) = zsumclasses( 8) 2093 ! 2094 ! ! Convert to TJ/s 2095 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-12 2096 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-12 2097 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-12 2098 ! 2099 ! ! limit maximum and minimum values in iom_put 2100 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2101 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2102 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2103 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2104 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2105 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2106 ! 2107 ! ! Set NaN's to Zero 2108 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2109 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2110 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2111 ! 2112 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2113 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2114 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2115 ! 2116 ! !noos_iom_dummy(:,:,1) = (zsumclasses( 7)+zsumclasses( 8)) 2117 ! !noos_iom_dummy(:,:,2) = zsumclasses( 7) 2118 ! !noos_iom_dummy(:,:,3) = zsumclasses( 8) 2119 ! 2120 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_heat' 2121 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 2122 ! CALL iom_put(noos_var_sect_name, noos_iom_dummy ) 2123 ! noos_iom_dummy(:,:,:) = 0. 2124 ! tmp_iom_output(:) = 0. 2125 ! 2126 ! tmp_iom_output(1) = (zsumclasses( 9)+zsumclasses( 10)) 2127 ! tmp_iom_output(2) = zsumclasses( 9) 2128 ! tmp_iom_output(3) = zsumclasses( 10) 2129 ! 2130 ! ! Convert to MT/s 2131 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 2132 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 2133 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 2134 ! 2135 ! 2136 ! ! limit maximum and minimum values in iom_put 2137 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2138 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2139 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2140 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2141 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2142 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2143 ! 2144 ! ! Set NaN's to Zero 2145 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2146 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2147 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2148 ! 2149 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2150 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2151 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2152 ! 2153 ! !noos_iom_dummy(:,:,1) = (zsumclasses( 9)+zsumclasses( 10)) 2154 ! !noos_iom_dummy(:,:,2) = zsumclasses( 9) 2155 ! !noos_iom_dummy(:,:,3) = zsumclasses( 10) 2156 ! 2157 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_salt' 2158 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 2159 ! CALL iom_put(noos_var_sect_name, noos_iom_dummy ) 2160 ! noos_iom_dummy(:,:,:) = 0. 2161 ! tmp_iom_output(:) = 0. 2162 ! ENDIF 2163 ! 2164 ! ENDIF 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 IF( lwp ) THEN 2176 IF ( ln_dct_ascii ) THEN 2177 !WRITE(numdct_NOOS,'(9e12.4E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 2178 WRITE(numdct_NOOS,'(3F18.3,6e16.8E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 2179 zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), & 2180 zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10) 2181 CALL FLUSH(numdct_NOOS) 2182 ELSE 2183 WRITE(numdct_NOOS) zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 2184 zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), & 2185 zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10) 2186 CALL FLUSH(numdct_NOOS) 2187 ENDIF 2188 ENDIF 2189 2190 IF ( ln_dct_iom_cont ) THEN 1682 2191 1683 1684 1685 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1686 1687 IF( lwp ) THEN 1688 WRITE(numdct_NOOS,'(9e12.4E2)') -(zsumclasses( 1)+zsumclasses( 2)), -zsumclasses( 2),-zsumclasses( 1), & 1689 -(zsumclasses( 7)+zsumclasses( 8)), -zsumclasses( 8),-zsumclasses( 7), & 1690 -(zsumclasses( 9)+zsumclasses(10)), -zsumclasses(10),-zsumclasses( 9) 1691 endif 1692 2192 noos_iom_dummy(:,:,:) = 0. 2193 tmp_iom_output(:) = 0. 1693 2194 1694 noos_iom_dummy(:,:,:) = 0. 2195 tmp_iom_output(1) = (zsumclasses( 1)+zsumclasses( 2)) 2196 tmp_iom_output(2) = zsumclasses( 1) 2197 tmp_iom_output(3) = zsumclasses( 2) 1695 2198 1696 noos_iom_dummy(:,:,1) = -(zsumclasses( 1)+zsumclasses( 2)) 1697 noos_iom_dummy(:,:,2) = -zsumclasses( 2) 1698 noos_iom_dummy(:,:,3) = -zsumclasses( 1) 2199 ! Convert to Sv 2200 tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 2201 tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 2202 tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 2203 2204 ! limit maximum and minimum values in iom_put 2205 if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2206 if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2207 if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2208 if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2209 if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2210 if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2211 2212 ! Set NaN's to Zero 2213 if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2214 if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2215 if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2216 2217 noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2218 noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2219 noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2220 2221 !noos_iom_dummy(:,:,1) = (zsumclasses( 1)+zsumclasses( 2)) 2222 !noos_iom_dummy(:,:,2) = zsumclasses( 1) 2223 !noos_iom_dummy(:,:,3) = zsumclasses( 2) 2224 2225 1699 2226 1700 2227 noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_trans' 1701 2228 if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1702 CALL iom_put( noos_var_sect_name, noos_iom_dummy )2229 CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 1703 2230 noos_iom_dummy(:,:,:) = 0. 2231 tmp_iom_output(:) = 0. 1704 2232 1705 noos_iom_dummy(:,:,1) = -(zsumclasses( 7)+zsumclasses( 8)) 1706 noos_iom_dummy(:,:,2) = -zsumclasses( 8) 1707 noos_iom_dummy(:,:,3) = -zsumclasses( 7) 2233 tmp_iom_output(1) = (zsumclasses( 7)+zsumclasses( 8)) 2234 tmp_iom_output(2) = zsumclasses( 7) 2235 tmp_iom_output(3) = zsumclasses( 8) 2236 2237 ! Convert to TJ/s 2238 tmp_iom_output(1) = tmp_iom_output(1)*1.E-12 2239 tmp_iom_output(2) = tmp_iom_output(2)*1.E-12 2240 tmp_iom_output(3) = tmp_iom_output(3)*1.E-12 2241 2242 ! limit maximum and minimum values in iom_put 2243 if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2244 if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2245 if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2246 if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2247 if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2248 if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2249 2250 ! Set NaN's to Zero 2251 if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2252 if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2253 if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2254 2255 noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2256 noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2257 noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2258 2259 !noos_iom_dummy(:,:,1) = (zsumclasses( 7)+zsumclasses( 8)) 2260 !noos_iom_dummy(:,:,2) = zsumclasses( 7) 2261 !noos_iom_dummy(:,:,3) = zsumclasses( 8) 1708 2262 1709 2263 noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_heat' 1710 2264 if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1711 CALL iom_put( noos_var_sect_name, noos_iom_dummy )2265 CALL iom_put(noos_var_sect_name, noos_iom_dummy ) 1712 2266 noos_iom_dummy(:,:,:) = 0. 2267 tmp_iom_output(:) = 0. 1713 2268 1714 noos_iom_dummy(:,:,1) = -(zsumclasses( 9)+zsumclasses( 10))1715 noos_iom_dummy(:,:,2) = -zsumclasses( 10)1716 noos_iom_dummy(:,:,3) = -zsumclasses( 9)2269 tmp_iom_output(1) = (zsumclasses( 9)+zsumclasses( 10)) 2270 tmp_iom_output(2) = zsumclasses( 9) 2271 tmp_iom_output(3) = zsumclasses( 10) 1717 2272 1718 noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_salt' 1719 if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1720 CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 1721 noos_iom_dummy(:,:,:) = 0. 1722 ELSE 1723 IF( lwp ) THEN 1724 WRITE(numdct_NOOS,'(9e12.4E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 1725 zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), & 1726 zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10) 1727 endif 1728 2273 ! Convert to MT/s 2274 tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 2275 tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 2276 tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 1729 2277 1730 noos_iom_dummy(:,:,1) = (zsumclasses( 1)+zsumclasses( 2))1731 noos_iom_dummy(:,:,2) = zsumclasses( 1)1732 noos_iom_dummy(:,:,3) = zsumclasses( 2)1733 2278 1734 noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_trans' 1735 if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1736 CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 1737 noos_iom_dummy(:,:,:) = 0. 2279 ! limit maximum and minimum values in iom_put 2280 if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2281 if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2282 if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2283 if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2284 if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2285 if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 1738 2286 1739 noos_iom_dummy(:,:,1) = (zsumclasses( 7)+zsumclasses( 8)) 1740 noos_iom_dummy(:,:,2) = zsumclasses( 7) 1741 noos_iom_dummy(:,:,3) = zsumclasses( 8) 2287 ! Set NaN's to Zero 2288 if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2289 if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2290 if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 1742 2291 1743 noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_heat' 1744 if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1745 CALL iom_put(noos_var_sect_name, noos_iom_dummy ) 1746 noos_iom_dummy(:,:,:) = 0. 2292 noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2293 noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2294 noos_iom_dummy(:,:,3) = tmp_iom_output(3) 1747 2295 1748 noos_iom_dummy(:,:,1) = (zsumclasses( 9)+zsumclasses( 10))1749 noos_iom_dummy(:,:,2) = zsumclasses( 9)1750 noos_iom_dummy(:,:,3) = zsumclasses( 10)2296 !noos_iom_dummy(:,:,1) = (zsumclasses( 9)+zsumclasses( 10)) 2297 !noos_iom_dummy(:,:,2) = zsumclasses( 9) 2298 !noos_iom_dummy(:,:,3) = zsumclasses( 10) 1751 2299 1752 2300 noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_salt' 1753 2301 if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1754 CALL iom_put(noos_var_sect_name, noos_iom_dummy ) 1755 noos_iom_dummy(:,:,:) = 0. 1756 1757 ENDIF 1758 1759 1760 DEALLOCATE(noos_iom_dummy) 2302 CALL iom_put(noos_var_sect_name, noos_iom_dummy ) 2303 noos_iom_dummy(:,:,:) = 0. 2304 tmp_iom_output(:) = 0. 2305 2306 2307 DEALLOCATE(noos_iom_dummy) 2308 ENDIF 2309 1761 2310 1762 2311 DO jclass=1,MAX(1,sec%nb_class-1) … … 1803 2352 1804 2353 !write volume transport per class 1805 1806 2354 IF( lwp ) THEN 1807 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1808 WRITE(numdct_NOOS,'(9e12.4E2)') -(sec%transport( 1,jclass)+sec%transport( 2,jclass)),-sec%transport( 2,jclass),-sec%transport( 1,jclass), & 1809 -(sec%transport( 7,jclass)+sec%transport( 8,jclass)),-sec%transport( 8,jclass),-sec%transport( 7,jclass), & 1810 -(sec%transport( 9,jclass)+sec%transport(10,jclass)),-sec%transport(10,jclass),-sec%transport( 9,jclass) 2355 2356 IF ( ln_dct_ascii ) THEN 2357 CALL FLUSH(numdct_NOOS) ! JT crash 2358 2359 2360 2361 !JT IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 2362 !JT WRITE(numdct_NOOS,'(9e12.4E2)') -(sec%transport( 1,jclass)+sec%transport( 2,jclass)),-sec%transport( 2,jclass),-sec%transport( 1,jclass), & 2363 !JT -(sec%transport( 7,jclass)+sec%transport( 8,jclass)),-sec%transport( 8,jclass),-sec%transport( 7,jclass), & 2364 !JT -(sec%transport( 9,jclass)+sec%transport(10,jclass)),-sec%transport(10,jclass),-sec%transport( 9,jclass) 2365 !JT ELSE 2366 !JT WRITE(numdct_NOOS,'(9e12.4E2)') sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), & 2367 !JT sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), & 2368 !JT sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass) 2369 !JT ENDIF 2370 2371 2372 !WRITE(numdct_NOOS,'(9e12.4E2)') sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), & 2373 ! sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), & 2374 ! sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass) 2375 WRITE(numdct_NOOS,'(3F18.3,6e16.8E2)') sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), & 2376 sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), & 2377 sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass) 1811 2378 ELSE 1812 WRITE(numdct_NOOS,'(9e12.4E2)') sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), & 1813 sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), & 1814 sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass) 2379 2380 CALL FLUSH(numdct_NOOS) ! JT crash 2381 WRITE(numdct_NOOS) sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), & 2382 sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), & 2383 sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass) 1815 2384 ENDIF 1816 2385 ENDIF … … 1818 2387 ENDDO 1819 2388 1820 if ( lwp ) CALL FLUSH(numdct_NOOS) 2389 !IF ( ln_dct_ascii ) THEN 2390 if ( lwp ) CALL FLUSH(numdct_NOOS) 2391 !ENDIF 1821 2392 1822 2393 CALL wrk_dealloc(nb_type , zsumclasses ) … … 1858 2429 IF( lwp ) THEN 1859 2430 WRITE(numout,*) " " 1860 WRITE(numout,*) "dia_dct_wri_NOOS_h: write transports through section sat timestep: ", hr2431 WRITE(numout,*) "dia_dct_wri_NOOS_h: write transports through section Transect:",ksec-1," at timestep: ", hr 1861 2432 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 1862 2433 ENDIF … … 1877 2448 zslope = sec%slopeSection 1878 2449 2450 ! Sum up all classes, to give the total per type (pos vol trans, neg vol trans etc...) 1879 2451 DO jclass=1,MAX(1,sec%nb_class-1) 1880 2452 zsumclasses(1:nb_type)=zsumclasses(1:nb_type)+sec%transport_h(1:nb_type,jclass) 1881 2453 ENDDO 1882 2454 2455 2456 ! JT 2457 ! JT 2458 ! JT 2459 ! JT 2460 ! JT I think changing the sign of output according to the zslope is redundant 2461 ! JT 2462 ! JT 2463 ! JT 2464 ! JT 2465 2466 ! JT !write volume transport per class 2467 ! JT ! Sum positive and vol trans for all classes in first cell of array 2468 ! JT IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 2469 ! JT ! JT z_hr_output(ksec,hr,1)=-(zsumclasses(1)+zsumclasses(2)) 2470 ! JT z_hr_output(ksec,1,1)=-(zsumclasses(1)+zsumclasses(2)) 2471 ! JT ELSE 2472 ! JT ! JT z_hr_output(ksec,hr,1)= (zsumclasses(1)+zsumclasses(2)) 2473 ! JT z_hr_output(ksec,1,1)= (zsumclasses(1)+zsumclasses(2)) 2474 ! JT ENDIF 2475 ! JT 2476 ! JT ! Sum positive and vol trans for each classes in following cell of array 2477 ! JT DO jclass=1,MAX(1,sec%nb_class-1) 2478 ! JT IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 2479 ! JT ! JT z_hr_output(ksec,hr,jclass+1)=-(sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 2480 ! JT z_hr_output(ksec,1,jclass+1)=-(sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 2481 ! JT ELSE 2482 ! JT ! JT z_hr_output(ksec,hr,jclass+1)= (sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 2483 ! JT z_hr_output(ksec,1,jclass+1)= (sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 2484 ! JT ENDIF 2485 ! JT ENDDO 2486 1883 2487 !write volume transport per class 1884 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1885 z_hr_output(ksec,hr,1)=-(zsumclasses(1)+zsumclasses(2)) 1886 ELSE 1887 z_hr_output(ksec,hr,1)= (zsumclasses(1)+zsumclasses(2)) 1888 ENDIF 1889 2488 ! Sum positive and vol trans for all classes in first cell of array 2489 2490 z_hr_output(ksec,1,1)= (zsumclasses(1)+zsumclasses(2)) 2491 z_hr_output(ksec,2,1)= zsumclasses(1) 2492 z_hr_output(ksec,3,1)= zsumclasses(2) 2493 2494 ! Sum positive and vol trans for each classes in following cell of array 1890 2495 DO jclass=1,MAX(1,sec%nb_class-1) 1891 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1892 z_hr_output(ksec,hr,jclass+1)=-(sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 2496 z_hr_output(ksec,1,jclass+1)= (sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 2497 z_hr_output(ksec,2,jclass+1)= sec%transport_h(1,jclass) 2498 z_hr_output(ksec,3,jclass+1)= sec%transport_h(2,jclass) 2499 ENDDO 2500 2501 2502 IF( lwp ) THEN 2503 ! JT IF ( hr .eq. 48._wp ) THEN 2504 ! JT WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1 2505 ! JT DO jhr=25,48 2506 ! JT WRITE(numdct_NOOS_h,'(11F12.1)') z_hr_output(ksec,jhr,1), (z_hr_output(ksec,jhr,jclass+1), jclass=1,MAX(1,10) ) 2507 ! JT ENDDO 2508 ! JT ENDIF 2509 2510 2511 2512 IF ( ln_dct_ascii ) THEN 2513 WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,'.',MOD(hr,24),'.',0,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1 2514 WRITE(numdct_NOOS_h,'(11F18.3)') z_hr_output(ksec,1,1), (z_hr_output(ksec,1,jclass+1), jclass=1,MAX(1,10) ) 2515 WRITE(numdct_NOOS_h,'(11F18.3)') z_hr_output(ksec,2,1), (z_hr_output(ksec,2,jclass+1), jclass=1,MAX(1,10) ) 2516 WRITE(numdct_NOOS_h,'(11F18.3)') z_hr_output(ksec,3,1), (z_hr_output(ksec,3,jclass+1), jclass=1,MAX(1,10) ) 2517 CALL FLUSH(numdct_NOOS_h) 1893 2518 ELSE 1894 z_hr_output(ksec,hr,jclass+1)= (sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 2519 WRITE(numdct_NOOS_h) nyear,nmonth,nday,MOD(hr,24),ksec-1,sec%nb_class-1 2520 WRITE(numdct_NOOS_h) z_hr_output(ksec,1,1), (z_hr_output(ksec,1,jclass+1), jclass=1,MAX(1,10) ) 2521 WRITE(numdct_NOOS_h) z_hr_output(ksec,2,1), (z_hr_output(ksec,2,jclass+1), jclass=1,MAX(1,10) ) 2522 WRITE(numdct_NOOS_h) z_hr_output(ksec,3,1), (z_hr_output(ksec,3,jclass+1), jclass=1,MAX(1,10) ) 2523 CALL FLUSH(numdct_NOOS_h) 1895 2524 ENDIF 1896 ENDDO 1897 1898 IF ( hr .eq. 48._wp ) THEN 1899 WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1 1900 DO jhr=25,48 1901 WRITE(numdct_NOOS_h,'(11F12.1)') z_hr_output(ksec,jhr,1), (z_hr_output(ksec,jhr,jclass+1), jclass=1,MAX(1,10) ) 1902 ENDDO 1903 ENDIF 2525 2526 2527 ENDIF 2528 1904 2529 1905 2530 CALL wrk_dealloc(nb_type , zsumclasses ) 1906 2531 1907 2532 DEALLOCATE(noos_iom_dummy) 1908 1909 1910 2533 1911 2534 -
branches/UKMO/CO6_shelfclimate_fabm_noos/NEMOGCM/NEMO/OPA_SRC/DIA/diaregmean.F90
r8672 r10492 730 730 ! Local variables 731 731 INTEGER, DIMENSION(jpi, jpj) :: internal_region_mask ! Input 3d field and mask 732 REAL(wp), DIMENSION(jpi, jpj) :: internal_infield ! Internal data field 732 733 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zrmet_ave,zrmet_tot,zrmet_var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id ,zrmet_min,zrmet_max 733 734 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrmet_out … … 744 745 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: dummy_zrmet 745 746 LOGICAL :: verbose 746 verbose = .F ALSE.747 verbose = .False. 747 748 748 749 … … 772 773 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_reg_id array' ) 773 774 774 775 775 776 776 777 IF(lwp .AND. verbose) THEN … … 779 780 WRITE(numout,*) 780 781 ENDIF 782 783 DO ji = 1,jpi 784 DO jj = 1,jpj 785 internal_infield(ji,jj) = infield(ji,jj) 786 END DO 787 END DO 788 789 ! Check for NANS # JT 03/09/2018 790 DO ji = 1,jpi 791 DO jj = 1,jpj 792 IF ( tmask(ji,jj,1) == 1.0_wp ) THEN 793 IF ( internal_infield(ji,jj) .ne. internal_infield(ji,jj) ) THEN 794 WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//' Nan at (kt,i,j): ',kt,ji - (-jpizoom+1-nimpp+1),jj - (-jpjzoom+1-njmpp+1) 795 internal_infield(ji,jj) = 0. 796 ENDIF 797 ELSE 798 IF ( internal_infield(ji,jj) .ne. internal_infield(ji,jj) ) THEN 799 WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//' Masked Nan at (kt,i,j): ',kt,ji - (-jpizoom+1-nimpp+1),jj - (-jpjzoom+1-njmpp+1) 800 internal_infield(ji,jj) = 0. 801 ENDIF 802 ENDIF 803 END DO 804 END DO 805 781 806 782 807 zrmet_ave(:) = zmdi … … 845 870 !WRITE(numout,*) kt,start_reg_mean_loop 846 871 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; begin spatial loops: ' 847 DO ji = 1,jpi848 DO jj = 1,jpj872 DO ji = nldi,nlei 873 DO jj = nldj,nlej 849 874 IF ( tmask(ji,jj,1) == 1.0_wp ) THEN 850 875 ind = internal_region_mask(ji,jj)+1 851 tot_mat(ind) = tot_mat(ind) + (in field(ji,jj))852 ssq_mat(ind) = ssq_mat(ind) + ( in field(ji,jj) *infield(ji,jj))876 tot_mat(ind) = tot_mat(ind) + (internal_infield(ji,jj)) 877 ssq_mat(ind) = ssq_mat(ind) + ( internal_infield(ji,jj) * internal_infield(ji,jj)) 853 878 cnt_mat(ind) = cnt_mat(ind) + 1. 854 879 855 min_mat(ind) = min(min_mat(ind),in field(ji,jj))856 max_mat(ind) = max(max_mat(ind),in field(ji,jj))880 min_mat(ind) = min(min_mat(ind),internal_infield(ji,jj)) 881 max_mat(ind) = max(max_mat(ind),internal_infield(ji,jj)) 857 882 ENDIF 858 883 END DO … … 963 988 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 964 989 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 965 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 990 if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20 966 991 zrmet_out(:,:,jm) = zrmet_val 967 992 END DO … … 977 1002 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 978 1003 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 979 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 1004 if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20 980 1005 zrmet_out(:,:,jm) = zrmet_val 981 1006 END DO … … 991 1016 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 992 1017 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 993 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 1018 if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20 994 1019 zrmet_out(:,:,jm) = zrmet_val 995 1020 END DO … … 1005 1030 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 1006 1031 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 1007 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 1032 if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20 1008 1033 zrmet_out(:,:,jm) = zrmet_val 1009 1034 END DO … … 1019 1044 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 1020 1045 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 1021 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 1046 if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20 1022 1047 zrmet_out(:,:,jm) = zrmet_val 1023 1048 END DO … … 1033 1058 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 1034 1059 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 1035 ! if (zrmet_val .NE. zrmet_val) zrmet_val = 0. 1060 if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20 1036 1061 zrmet_out(:,:,jm) = zrmet_val 1037 1062 END DO
Note: See TracChangeset
for help on using the changeset viewer.
