Changeset 15402 for NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE
- Timestamp:
- 2021-10-19T15:06:11+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/DIA/diaregmean.F90
r15397 r15402 915 915 INTEGER, DIMENSION(jpi, jpj) :: internal_region_mask ! Input 3d field and mask 916 916 REAL(wp), DIMENSION(jpi, jpj) :: internal_infield ! Internal data field 917 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zrmet_ave,zrmet_tot,zrmet_ var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id ,zrmet_min,zrmet_max917 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zrmet_ave,zrmet_tot,zrmet_totarea,zrmet_var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id ,zrmet_min,zrmet_max 918 918 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zrmet_out 919 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ave_mat,tot_mat,num_mat,var_mat,ssq_mat,cnt_mat,reg_id_mat,mask_id_mat !: region_mask919 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ave_mat,tot_mat,num_mat,var_mat,ssq_mat,cnt_mat,reg_id_mat,mask_id_mat,area_mat,totarea_mat !: region_mask 920 920 !REAL(wp), ALLOCATABLE, DIMENSION(:) :: min_mat,max_mat !: region_mask 921 921 … … 942 942 ALLOCATE( zrmet_tot(n_regions_output), STAT= ierr ) 943 943 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_tot array' ) 944 ALLOCATE( zrmet_totarea(n_regions_output), STAT= ierr ) 945 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_totarea array' ) 944 946 ALLOCATE( zrmet_var(n_regions_output), STAT= ierr ) 945 947 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate zrmet_var array' ) … … 994 996 zrmet_ave(:) = zmdi 995 997 zrmet_tot(:) = zmdi 998 zrmet_totarea(:) = zmdi 996 999 zrmet_var(:) = zmdi 997 1000 zrmet_cnt(:) = zmdi … … 1026 1029 ALLOCATE( cnt_mat(nreg), STAT= ierr ) 1027 1030 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate cnt_mat array' ) 1031 ALLOCATE( area_mat(nreg), STAT= ierr ) 1032 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate area_mat array' ) 1033 ALLOCATE( totarea_mat(nreg), STAT= ierr ) 1034 IF( ierr /= 0 ) CALL ctl_stop( 'dia_wri_region_mean: failed to allocate totarea_mat array' ) 1028 1035 1029 1036 !ALLOCATE( min_mat(nreg), STAT= ierr ) … … 1045 1052 cnt_mat(:) = 0. 1046 1053 ssq_mat(:) = 0. 1054 area_mat(:) = 0. 1055 totarea_mat(:) = 0. 1056 1047 1057 1048 1058 !min_mat(:) = zmdi … … 1065 1075 !cnt_mat(ind) = cnt_mat(ind) + 1. 1066 1076 ! Area Weighted values - region_area_mat == 1. or area depending on ln_diaregmean_areawgt 1067 tot_mat(ind) = tot_mat(ind) + (region_area_mat(ji,jj)*internal_infield(ji,jj)) 1077 totarea_mat(ind) = totarea_mat(ind) + (region_area_mat(ji,jj)*internal_infield(ji,jj)) 1078 tot_mat(ind) = tot_mat(ind) + (internal_infield(ji,jj)) 1068 1079 ssq_mat(ind) = ssq_mat(ind) + (region_area_mat(ji,jj)*(internal_infield(ji,jj) * internal_infield(ji,jj))) 1069 cnt_mat(ind) = cnt_mat(ind) + (region_area_mat(ji,jj)*1.) 1080 cnt_mat(ind) = cnt_mat(ind) + 1. 1081 area_mat(ind) = area_mat(ind) + (region_area_mat(ji,jj)*1.) 1070 1082 1071 1083 … … 1082 1094 CALL mpp_sum( 'diaregionmean',cnt_mat,nreg ) 1083 1095 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum cnt' 1096 CALL mpp_sum( 'diaregionmean',area_mat,nreg ) 1097 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum area' 1098 CALL mpp_sum( 'diaregionmean',totarea_mat,nreg ) 1099 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_wri_region_mean : '//tmp_name//'; finished mpp_sum totarea_mat' 1084 1100 1085 1101 … … 1107 1123 1108 1124 !calculate the mean and variance from the total, sum of squares and the count. 1109 1110 ave_mat = tot_mat(:)/cnt_mat(:) 1111 var_mat = ssq_mat(:)/cnt_mat(:) - (ave_mat(:)*ave_mat(:)) 1125 ! When area weighting, you can't area weight the total. 1126 ! this if block may be redundant, as totarea_mat == tot_mat, and cnt_mat == area_mat when ln_diaregmean_areawgt == False 1127 IF (ln_diaregmean_areawgt) THEN 1128 ave_mat = totarea_mat(:)/area_mat(:) 1129 var_mat = ssq_mat(:)/area_mat(:) - (ave_mat(:)*ave_mat(:)) 1130 ELSE 1131 ave_mat = tot_mat(:)/cnt_mat(:) 1132 var_mat = ssq_mat(:)/cnt_mat(:) - (ave_mat(:)*ave_mat(:)) 1133 ENDIF 1134 1112 1135 1113 1136 … … 1158 1181 zrmet_ave( reg_ind_cnt) = ave_mat(jm) 1159 1182 zrmet_tot( reg_ind_cnt) = tot_mat(jm) 1183 zrmet_totarea( reg_ind_cnt) = totarea_mat(jm) 1160 1184 zrmet_var( reg_ind_cnt) = var_mat(jm) 1161 1185 zrmet_cnt( reg_ind_cnt) = cnt_mat(jm) … … 1170 1194 1171 1195 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean about to deallocated arrays for ',kt,maskno 1172 DEALLOCATE(ave_mat,tot_mat,num_mat,var_mat,ssq_mat,cnt_mat,reg_id_mat,mask_id_mat )1196 DEALLOCATE(ave_mat,tot_mat,num_mat,var_mat,ssq_mat,cnt_mat,reg_id_mat,mask_id_mat,totarea_mat, area_mat) 1173 1197 !DEALLOCATE(min_mat,max_mat) 1174 1198 … … 1213 1237 DO jm = 1,n_regions_output 1214 1238 zrmet_val = zrmet_tot(jm) 1239 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 1240 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 1241 if (zrmet_val .NE. zrmet_val) zrmet_val = 1e20 1242 zrmet_out(jm) = zrmet_val 1243 END DO 1244 IF(lwp .AND. verbose) WRITE(numout,*) 'dia_regmean iom_put tmp_name_iom : ',trim(tmp_name_iom), zrmet_out(1) 1245 CALL iom_put( trim(tmp_name_iom), zrmet_out(:) ) 1246 zrmet_out(:) = 0 1247 zrmet_val = 0 1248 tmp_name_iom = '' 1249 ENDIF 1250 1251 1252 1253 tmp_name_iom = trim(trim("reg_") // trim(tmp_name) // trim('_totarea')) 1254 IF (iom_use(trim(tmp_name_iom))) THEN 1255 DO jm = 1,n_regions_output 1256 zrmet_val = zrmet_totarea(jm) 1215 1257 ! if (zrmet_val .LT. -1e16) zrmet_val = -1e16 1216 1258 ! if (zrmet_val .GT. 1e16) zrmet_val = 1e16 … … 1337 1379 ENDIF 1338 1380 1339 DEALLOCATE(zrmet_ave,zrmet_tot,zrmet_ var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id,zrmet_min,zrmet_max,zrmet_out)1381 DEALLOCATE(zrmet_ave,zrmet_tot,zrmet_totarea,zrmet_var,zrmet_cnt,zrmet_mask_id,zrmet_reg_id,zrmet_min,zrmet_max,zrmet_out) 1340 1382 1341 1383 IF(lwp .AND. verbose) THEN ! Control print
Note: See TracChangeset
for help on using the changeset viewer.