Changeset 15611
- Timestamp:
- 2021-12-17T20:04:49+01:00 (2 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/DIA/diaharm_fast.F90
r15608 r15611 760 760 REAL(wp) :: a_u, b_u, a_v, b_v, twodelta, delta, alpha2, alpha, qmin, qmax, ecc,thetamax, thetamin 761 761 REAL(wp) :: Qc, Qac, gc,gac, Phi_Ua, dir_Ua, polarity 762 REAL(wp) :: u_off, v_off 762 763 REAL(wp) :: tmpreal 763 764 764 765 REAL(wp), ALLOCATABLE,DIMENSION(:,:) :: tmp_u_amp_2d_mat,tmp_v_amp_2d_mat,tmp_u_phi_2d_mat,tmp_v_phi_2d_mat 766 REAL(wp), ALLOCATABLE,DIMENSION(:,:) :: TA_u_off_t_uvbar, TA_v_off_t_uvbar 767 REAL(wp), ALLOCATABLE,DIMENSION(:,:) :: TA_u_off_uvbar, TA_v_off_uvbar 765 768 REAL(wp), ALLOCATABLE,DIMENSION(:,:) :: a_u_2d_mat,b_u_2d_mat,a_v_2d_mat,b_v_2d_mat 766 769 REAL(wp), ALLOCATABLE,DIMENSION(:,:) :: qmax_2d_mat,qmin_2d_mat,ecc_2d_mat … … 770 773 771 774 REAL(wp), ALLOCATABLE,DIMENSION(:,:,:) :: tmp_u_amp_3d_mat,tmp_v_amp_3d_mat,tmp_u_phi_3d_mat,tmp_v_phi_3d_mat 775 REAL(wp), ALLOCATABLE,DIMENSION(:,:,:) :: TA_u_off_t_uv3d, TA_v_off_t_uv3d 776 REAL(wp), ALLOCATABLE,DIMENSION(:,:,:) :: TA_u_off_uv3d, TA_v_off_uv3d 772 777 REAL(wp), ALLOCATABLE,DIMENSION(:,:,:) :: a_u_3d_mat,b_u_3d_mat,a_v_3d_mat,b_v_3d_mat 773 778 REAL(wp), ALLOCATABLE,DIMENSION(:,:,:) :: qmax_3d_mat,qmin_3d_mat,ecc_3d_mat … … 782 787 IF (ln_ana_uvbar) THEN 783 788 ALLOCATE( amp_u2d(nb_ana,jpi,jpj), amp_v2d(nb_ana,jpi,jpj), phi_u2d(nb_ana,jpi,jpj), phi_v2d(nb_ana,jpi,jpj) ) 789 790 ALLOCATE( TA_u_off_t_uvbar(jpi,jpj), TA_v_off_t_uvbar(jpi,jpj) ) 791 ALLOCATE( TA_u_off_uvbar(jpi,jpj), TA_v_off_uvbar(jpi,jpj) ) 784 792 785 793 ALLOCATE(tmp_u_amp_2d_mat(jpi,jpj),tmp_v_amp_2d_mat(jpi,jpj),tmp_u_phi_2d_mat(jpi,jpj),tmp_v_phi_2d_mat(jpi,jpj)) … … 795 803 IF (ln_ana_uv3d) THEN 796 804 ALLOCATE( amp_u3d(nb_ana,jpi,jpj,jpk), amp_v3d(nb_ana,jpi,jpj,jpk), phi_u3d(nb_ana,jpi,jpj,jpk), phi_v3d(nb_ana,jpi,jpj,jpk) ) 805 806 ALLOCATE( TA_u_off_t_uv3d(jpi,jpj,jpk), TA_v_off_t_uv3d(jpi,jpj,jpk) ) 807 ALLOCATE( TA_u_off_uv3d(jpi,jpj,jpk), TA_v_off_uv3d(jpi,jpj,jpk) ) 797 808 798 809 ALLOCATE(tmp_u_amp_3d_mat(jpi,jpj,jpk),tmp_v_amp_3d_mat(jpi,jpj,jpk),tmp_u_phi_3d_mat(jpi,jpj,jpk),tmp_v_phi_3d_mat(jpi,jpj,jpk)) … … 911 922 CALL FLUSH(numout) 912 923 913 enddo 924 925 926 927 928 929 IF (ln_diaharm_postproc_vel .AND. ln_ana_uvbar) THEN 930 931 !IF (m_posi_2d(jgrid) == 2) THEN 932 IF (TRIM(suffix) == TRIM('u2d')) THEN 933 if (lwp) WRITE(numout,*) "diaharm_fast ln_diaharm_postproc_vel: TA_u_off_uvbar" 934 do jj=1,nlcj 935 do ji=1,nlci 936 if (ssumask(ji,jj) == 1) THEN 937 TA_u_off_uvbar(ji,jj) = g_cosamp2D( 0,ji,jj,jgrid) 938 else 939 TA_u_off_uvbar(ji,jj) = 0. 940 ENDIF 941 enddo !ji 942 enddo !jj 943 ENDIF !u2d 944 945 !IF (m_posi_2d(jgrid) == 3) THEN 946 IF (TRIM(suffix) == TRIM('v2d')) THEN 947 if (lwp) WRITE(numout,*) "diaharm_fast ln_diaharm_postproc_vel: TA_v_off_uvbar" 948 do jj=1,nlcj 949 do ji=1,nlci 950 if (ssvmask(ji,jj) == 1) THEN 951 TA_v_off_uvbar(ji,jj) = g_cosamp2D( 0,ji,jj,jgrid) 952 else 953 TA_v_off_uvbar(ji,jj) = 0. 954 ENDIF 955 enddo !ji 956 enddo !jj 957 ENDIF !uvd 958 959 960 ENDIF ! ln_diaharm_postproc_vel .AND. ln_ana_uvbar 961 962 963 enddo ! jgrid=1,nvar_2d 914 964 ! 915 965 ! DO THE SAME FOR 3D VARIABLES … … 1000 1050 phi_v3d(jh,ji,jj,jk) = rpi*g_out3D(ji,jj,jk)/180.0 1001 1051 else 1002 amp_v3d(jh,ji,jj,jk) = 0 1003 phi_v3d(jh,ji,jj,jk) = 0 1052 amp_v3d(jh,ji,jj,jk) = 0. 1053 phi_v3d(jh,ji,jj,jk) = 0. 1004 1054 ENDIF 1005 1055 enddo … … 1023 1073 ENDIF 1024 1074 1025 enddo ! jgrid 1075 1076 1077 1078 1079 1080 1081 IF (ln_diaharm_postproc_vel .AND. ln_ana_uv3d) THEN 1082 1083 !IF (m_posi_2d(jgrid) == 2) THEN 1084 IF (TRIM(suffix) == TRIM('u3d')) THEN 1085 if (lwp) WRITE(numout,*) "diaharm_fast ln_diaharm_postproc_vel: TA_u_off_uv3d" 1086 DO jk=1,jpkm1 1087 do jj=1,nlcj 1088 do ji=1,nlci 1089 if (umask(ji,jj,jk) == 1) THEN 1090 TA_u_off_uv3d(ji,jj,jk) = g_cosamp3D( 0,ji,jj,jk,jgrid) 1091 else 1092 TA_u_off_uv3d(ji,jj,jk) = 0. 1093 ENDIF 1094 enddo 1095 enddo 1096 enddo 1097 ENDIF 1098 1099 !IF (m_posi_2d(jgrid) == 3) THEN 1100 IF (TRIM(suffix) == TRIM('v3d')) THEN 1101 if (lwp) WRITE(numout,*) "diaharm_fast ln_diaharm_postproc_vel: TA_v_off_uv3d" 1102 DO jk=1,jpkm1 1103 do jj=1,nlcj 1104 do ji=1,nlci 1105 if (vmask(ji,jj,jk) == 1) THEN 1106 TA_v_off_uv3d(ji,jj,jk) = g_cosamp3D( 0,ji,jj,jk,jgrid) 1107 else 1108 TA_v_off_uv3d(ji,jj,jk) = 0. 1109 ENDIF 1110 enddo !jk 1111 enddo !ji 1112 enddo !jj 1113 ENDIF !uvd 1114 1115 1116 ENDIF ! ln_diaharm_postproc_vel .AND. ln_ana_uv3d 1117 1118 1119 enddo ! jgrid=1,nvar_2d 1120 1121 1026 1122 1027 1123 CALL FLUSH(numout) 1028 1124 1125 1126 1127 1128 IF (ln_diaharm_postproc_vel ) THEN 1129 1130 1131 TA_u_off_t_uvbar(:,:) = 0. 1132 TA_v_off_t_uvbar(:,:) = 0. 1133 1134 DO jj = 1, nlcj !- 1 1135 DO ji = 1, nlci ! - 1 1136 1137 IF ( ((ssumask(ji,jj) + ssumask(ji-1,jj)) > 0 ) .AND. ((ssvmask(ji,jj) + ssvmask(ji,jj-1)) > 0 ) ) THEN 1138 1139 if ( (ssumask(ji,jj) == 1) .AND. (ssumask(ji-1,jj) == 1)) then 1140 u_off = ((TA_u_off_uvbar(ji,jj)*ssumask(ji,jj)) + (TA_u_off_uvbar(ji-1,jj)*ssumask(ji-1,jj)))/(ssumask(ji,jj) + ssumask(ji-1,jj)) 1141 else if ( (ssumask(ji,jj) == 1) .AND. (ssumask(ji-1,jj) == 0)) then 1142 u_off = (TA_u_off_uvbar(ji,jj)*ssumask(ji,jj)) 1143 else if ( (ssumask(ji,jj) == 0) .AND. (ssumask(ji-1,jj) == 1)) then 1144 u_off = (TA_u_off_uvbar(ji-1,jj)*ssumask(ji-1,jj)) 1145 else 1146 cycle 1147 end if 1148 1149 1150 if ( (ssvmask(ji,jj) == 1) .AND. (ssvmask(ji,jj-1) == 1)) then 1151 v_off = ((TA_v_off_uvbar(ji,jj)*ssvmask(ji,jj)) + (TA_v_off_uvbar(ji,jj-1)*ssvmask(ji,jj-1)))/(ssvmask(ji,jj) + ssvmask(ji,jj-1)) 1152 else if ( (ssvmask(ji,jj) == 1) .AND. (ssvmask(ji,jj-1) == 0)) then 1153 v_off = (TA_v_off_uvbar(ji,jj)*ssvmask(ji,jj)) 1154 else if ( (ssvmask(ji,jj) == 0) .AND. (ssvmask(ji,jj-1) == 1)) then 1155 v_off = (TA_v_off_uvbar(ji,jj-1)*ssvmask(ji,jj-1)) 1156 else 1157 cycle 1158 end if 1159 1160 TA_u_off_t_uvbar(ji,jj) = u_off 1161 TA_v_off_t_uvbar(ji,jj) = v_off 1162 1163 ENDIF 1164 END DO !ji 1165 END DO !jj 1166 1167 tmp_name='TA_u_off_t_uvbar' 1168 IF( iom_use(TRIM(tmp_name)) ) THEN 1169 IF(lwp .AND. ln_diaharm_verbose) WRITE(numout,*) "diaharm_fast: iom_put: ",TRIM(tmp_name) 1170 CALL iom_put( TRIM(tmp_name), TA_u_off_t_uvbar(:,:)) 1171 ENDIF 1172 tmp_name='TA_v_off_t_uvbar' 1173 IF( iom_use(TRIM(tmp_name)) ) THEN 1174 IF(lwp .AND. ln_diaharm_verbose) WRITE(numout,*) "diaharm_fast: iom_put: ",TRIM(tmp_name) 1175 CALL iom_put( TRIM(tmp_name), TA_v_off_t_uvbar(:,:)) 1176 ENDIF 1177 1178 TA_u_off_t_uvbar(:,:) = 0. 1179 TA_v_off_t_uvbar(:,:) = 0. 1180 1181 1182 1183 TA_u_off_t_uv3d(:,:,:) = 0. 1184 TA_v_off_t_uv3d(:,:,:) = 0. 1185 1186 DO jk=1,jpkm1 1187 DO jj = 1, nlcj !- 1 1188 DO ji = 1, nlci ! - 1 1189 1190 IF ( ((umask(ji,jj,jk) + umask(ji-1,jj,jk)) > 0 ) .AND. ((vmask(ji,jj,jk) + vmask(ji,jj-1,jk)) > 0 ) ) THEN 1191 1192 if ( (umask(ji,jj,jk) == 1) .AND. (umask(ji-1,jj,jk) == 1)) then 1193 u_off = ((TA_u_off_uv3d(ji,jj,jk)*umask(ji,jj,jk)) + (TA_u_off_uv3d(ji-1,jj,jk)*umask(ji-1,jj,jk)))/(umask(ji,jj,jk) + umask(ji-1,jj,jk)) 1194 else if ( (umask(ji,jj,jk) == 1) .AND. (umask(ji-1,jj,jk) == 0)) then 1195 u_off = (TA_u_off_uv3d(ji,jj,jk)*umask(ji,jj,jk)) 1196 else if ( (umask(ji,jj,jk) == 0) .AND. (umask(ji-1,jj,jk) == 1)) then 1197 u_off = (TA_u_off_uv3d(ji-1,jj,jk)*umask(ji-1,jj,jk)) 1198 else 1199 cycle 1200 end if 1201 1202 1203 if ( (vmask(ji,jj,jk) == 1) .AND. (vmask(ji,jj-1,jk) == 1)) then 1204 v_off = ((TA_v_off_uv3d(ji,jj,jk)*vmask(ji,jj,jk)) + (TA_v_off_uv3d(ji,jj-1,jk)*vmask(ji,jj-1,jk)))/(vmask(ji,jj,jk) + vmask(ji,jj-1,jk)) 1205 else if ( (vmask(ji,jj,jk) == 1) .AND. (vmask(ji,jj-1,jk) == 0)) then 1206 v_off = (TA_v_off_uv3d(ji,jj,jk)*vmask(ji,jj,jk)) 1207 else if ( (vmask(ji,jj,jk) == 0) .AND. (vmask(ji,jj-1,jk) == 1)) then 1208 v_off = (TA_v_off_uv3d(ji,jj-1,jk)*vmask(ji,jj-1,jk)) 1209 else 1210 cycle 1211 end if 1212 1213 TA_u_off_t_uv3d(ji,jj,jk) = u_off 1214 TA_v_off_t_uv3d(ji,jj,jk) = v_off 1215 1216 ENDIF 1217 END DO !ji 1218 END DO !jj 1219 END DO !jk 1220 1221 tmp_name='TA_u_off_t_uv3d' 1222 IF( iom_use(TRIM(tmp_name)) ) THEN 1223 IF(lwp .AND. ln_diaharm_verbose) WRITE(numout,*) "diaharm_fast: iom_put: ",TRIM(tmp_name) 1224 CALL iom_put( TRIM(tmp_name), TA_u_off_t_uv3d(:,:,:)) 1225 ENDIF 1226 tmp_name='TA_v_off_t_uv3d' 1227 IF( iom_use(TRIM(tmp_name)) ) THEN 1228 IF(lwp .AND. ln_diaharm_verbose) WRITE(numout,*) "diaharm_fast: iom_put: ",TRIM(tmp_name) 1229 CALL iom_put( TRIM(tmp_name), TA_v_off_t_uv3d(:,:,:)) 1230 ENDIF 1231 1232 TA_u_off_t_uv3d(:,:,:) = 0. 1233 TA_v_off_t_uv3d(:,:,:) = 0. 1234 1235 ENDIF 1029 1236 1030 1237 IF (ln_diaharm_postproc_vel ) THEN … … 1070 1277 1071 1278 tmp_u_amp = ((amp_u2d(jh,ji,jj)*ssumask(ji,jj)) + (amp_u2d(jh,ji-1,jj)*ssumask(ji-1,jj)))/(ssumask(ji,jj) + ssumask(ji-1,jj)) 1072 !tmp_u_phi = ((phi_u2d(jh,ji,jj)*ssumask(ji,jj)) + (phi_u2d(jh,ji-1,jj)*ssumask(ji-1,jj)))/(ssumask(ji,jj) + ssumask(ji-1,jj))1073 1279 tmp_u_phi = atan2((sin(phi_u2d(jh,ji,jj)) + sin(phi_u2d(jh,ji-1,jj))),(cos(phi_u2d(jh,ji,jj)) + cos(phi_u2d(jh,ji-1,jj)))) 1074 1280 else if ( (ssumask(ji,jj) == 1) .AND. (ssumask(ji-1,jj) == 0)) then … … 1085 1291 if ( (ssvmask(ji,jj) == 1) .AND. (ssvmask(ji,jj-1) == 1)) then 1086 1292 tmp_v_amp = ((amp_v2d(jh,ji,jj)*ssvmask(ji,jj)) + (amp_v2d(jh,ji,jj-1)*ssvmask(ji,jj-1)))/(ssvmask(ji,jj) + ssvmask(ji,jj-1)) 1087 !tmp_v_phi = ((phi_v2d(jh,ji,jj)*ssvmask(ji,jj)) + (phi_v2d(jh,ji,jj-1)*ssvmask(ji,jj-1)))/(ssvmask(ji,jj) + ssvmask(ji,jj-1))1088 1293 tmp_v_phi = atan2((sin(phi_v2d(jh,ji,jj)) + sin(phi_v2d(jh,ji,jj-1))),(cos(phi_v2d(jh,ji,jj)) + cos(phi_v2d(jh,ji,jj-1)))) 1089 1294 else if ( (ssvmask(ji,jj) == 1) .AND. (ssvmask(ji,jj-1) == 0)) then … … 1092 1297 else if ( (ssvmask(ji,jj) == 0) .AND. (ssvmask(ji,jj-1) == 1)) then 1093 1298 tmp_v_amp = (amp_v2d(jh,ji,jj-1)*ssvmask(ji,jj-1)) 1094 !tmp_v_phi = (phi_v2d(jh,ji,jj-1)*ssvmask(ji,jj-1))1095 1299 tmp_v_phi = (phi_v2d(jh,ji,jj-1)*ssvmask(ji,jj-1)) 1096 1300 else … … 1378 1582 1379 1583 DO jk=1,jpkm1 1380 !DO jj = 2, nlcj ! - 11381 ! DO ji = 2, nlci ! - 11382 1383 ! DO jj = 1, jpjm1 #works1384 ! DO ji = 1, jpim11385 1386 1584 DO jj = 1, nlcj !- 1 1387 1585 DO ji = 1, nlci ! - 1 1388 1586 1389 1390 ! do jj=2,nlcj1391 ! do ji=2,nlci1392 !IF ((umask(ji,jj) + umask(ji-1,jj)) == 0 ) CYCLE1393 !IF ((vmask(ji,jj) + vmask(ji,jj-1)) == 0 ) CYCLE1394 1395 1587 IF ( ((umask(ji,jj,jk) + umask(ji-1,jj,jk)) > 0 ) .AND. ((vmask(ji,jj,jk) + vmask(ji,jj-1,jk)) > 0 ) ) THEN 1396 !tmp_u_amp = ((amp_u3d(jh,ji,jj,jk)*umask(ji,jj,jk)) + (amp_u3d(jh,ji-1,jj,jk)*umask(ji-1,jj,jk)))/(umask(ji,jj,jk) + umask(ji-1,jj,jk))1397 !tmp_v_amp = ((amp_v3d(jh,ji,jj,jk)*vmask(ji,jj,jk)) + (amp_v3d(jh,ji,jj-1,jk)*vmask(ji,jj-1,jk)))/(vmask(ji,jj,jk) + vmask(ji,jj-1,jk))1398 ! WORK ON THE WRAP AROUND1399 !tmp_u_phi = ((phi_u3d(jh,ji,jj,jk)*umask(ji,jj,jk)) + (phi_u3d(jh,ji-1,jj,jk)*umask(ji-1,jj,jk)))/(umask(ji,jj,jk) + umask(ji-1,jj,jk))1400 !tmp_v_phi = ((phi_v3d(jh,ji,jj,jk)*vmask(ji,jj,jk)) + (phi_v3d(jh,ji,jj-1,jk)*vmask(ji,jj-1,jk)))/(vmask(ji,jj,jk) + vmask(ji,jj-1,jk))1401 1588 1402 1589 if ( (umask(ji,jj,jk) == 1) .AND. (umask(ji-1,jj,jk) == 1)) then 1403 1590 tmp_u_amp = ((amp_u3d(jh,ji,jj,jk)*umask(ji,jj,jk)) + (amp_u3d(jh,ji-1,jj,jk)*umask(ji-1,jj,jk)))/(umask(ji,jj,jk) + umask(ji-1,jj,jk)) 1404 !tmp_u_phi = ((phi_u3d(jh,ji,jj,jk)*umask(ji,jj,jk)) + (phi_u3d(jh,ji-1,jj,jk)*umask(ji-1,jj,jk)))/(umask(ji,jj,jk) + umask(ji-1,jj,jk))1405 1591 tmp_u_phi = atan2((sin(phi_u3d(jh,ji,jj,jk)) + sin(phi_u3d(jh,ji-1,jj,jk))),(cos(phi_u3d(jh,ji,jj,jk)) + cos(phi_u3d(jh,ji-1,jj,jk)))) 1406 1592 else if ( (umask(ji,jj,jk) == 1) .AND. (umask(ji-1,jj,jk) == 0)) then … … 1417 1603 if ( (vmask(ji,jj,jk) == 1) .AND. (vmask(ji,jj-1,jk) == 1)) then 1418 1604 tmp_v_amp = ((amp_v3d(jh,ji,jj,jk)*vmask(ji,jj,jk)) + (amp_v3d(jh,ji,jj-1,jk)*vmask(ji,jj-1,jk)))/(vmask(ji,jj,jk) + vmask(ji,jj-1,jk)) 1419 !tmp_v_phi = ((phi_v3d(jh,ji,jj,jk)*vmask(ji,jj,jk)) + (phi_v3d(jh,ji,jj-1,jk)*vmask(ji,jj-1,jk)))/(vmask(ji,jj,jk) + vmask(ji,jj-1,jk))1420 1605 tmp_v_phi = atan2((sin(phi_v3d(jh,ji,jj,jk)) + sin(phi_v3d(jh,ji,jj-1,jk))),(cos(phi_v3d(jh,ji,jj,jk)) + cos(phi_v3d(jh,ji,jj-1,jk)))) 1421 1606 else if ( (vmask(ji,jj,jk) == 1) .AND. (vmask(ji,jj-1,jk) == 0)) then … … 1706 1891 1707 1892 DEALLOCATE(amp_u2d, amp_v2d, phi_u2d, phi_v2d ) 1893 DEALLOCATE(TA_u_off_t_uvbar, TA_v_off_t_uvbar ) 1894 DEALLOCATE(TA_u_off_uvbar, TA_v_off_uvbar ) 1708 1895 1709 1896 DEALLOCATE(tmp_u_amp_2d_mat, tmp_v_amp_2d_mat, tmp_u_phi_2d_mat, tmp_v_phi_2d_mat ) … … 1721 1908 1722 1909 DEALLOCATE(amp_u3d, amp_v3d, phi_u3d, phi_v3d ) 1910 DEALLOCATE(TA_u_off_t_uv3d, TA_v_off_t_uv3d ) 1911 DEALLOCATE(TA_u_off_uv3d, TA_v_off_uv3d ) 1723 1912 1724 1913 DEALLOCATE(tmp_u_amp_3d_mat, tmp_v_amp_3d_mat, tmp_u_phi_3d_mat, tmp_v_phi_3d_mat )
Note: See TracChangeset
for help on using the changeset viewer.