New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 15576 for NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate – NEMO

Ignore:
Timestamp:
2021-12-06T10:53:02+01:00 (2 years ago)
Author:
hadjt
Message:

Work in progress - diaharm_fast namelist keyword added to caluclate tidal current parameters - but causes a segmentation error crash in diaregmean when enabled.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/DIA/diaharm_fast.F90

    r15575 r15576  
    8282   LOGICAL, PUBLIC :: ln_diaharm_update_nodal_daily   !: =T  update the nodes every day 
    8383   LOGICAL, PUBLIC :: ln_diaharm_fast 
     84   LOGICAL, PUBLIC :: ln_diaharm_postproc_vel 
    8485 
    8586 
     
    361362 
    362363      NAMELIST/nam_diaharm_fast/ ln_diaharm_fast, ln_diaharm_store, ln_diaharm_compute, ln_diaharm_read_restart, ln_ana_ssh, ln_ana_uvbar, ln_ana_bfric, ln_ana_rho, ln_ana_uv3d, ln_ana_w3d, & 
    363                & tname,ln_diaharm_multiyear,nn_diaharm_multiyear,ln_diaharm_update_nodal_daily 
     364               & tname,ln_diaharm_multiyear,nn_diaharm_multiyear,ln_diaharm_update_nodal_daily,ln_diaharm_postproc_vel 
    364365      !!---------------------------------------------------------------------- 
    365366      !JT 
     
    408409         WRITE(numout,*) '   Multi-year harmonic analysis - number of years: ln_diaharm_update_nodal_daily = ', ln_diaharm_update_nodal_daily 
    409410         WRITE(numout,*) '   Number of Harmonics: nyear, nmonth = ', nyear, nmonth 
     411         WRITE(numout,*) '   Post-process velocity stats: ln_diaharm_postproc_vel = ', ln_diaharm_postproc_vel 
    410412 
    411413      ENDIF 
     
    742744!      REAL(wp) :: zsto1, zsto2, zout, zmax, zjulian, zdt, zmdi  ! temporary scalars 
    743745 
     746      REAL(wp), ALLOCATABLE,DIMENSION(:,:,:)       :: amp_u2d,phi_u2d, amp_v2d,phi_v2d  ! arrays for output 
     747 
     748      REAL(wp)   :: tmp_u_amp ,tmp_v_amp ,tmp_u_phi ,tmp_v_phi 
     749      REAL(wp)   :: a_u, b_u, a_v, b_v, twodelta, delta, alpha2, alpha, qmin, qmax, ecc,thetamax, thetamin 
     750      REAL(wp)   :: Qc, Qac, gc,gac, Phi_Ua, dir_Ua, polarity 
     751      REAL(wp)   :: tmpreal 
     752 
     753      REAL(wp), ALLOCATABLE,DIMENSION(:,:)         :: tmp_u_amp_mat,tmp_v_amp_mat,tmp_u_phi_mat,tmp_v_phi_mat 
     754!      REAL(wp), ALLOCATABLE,DIMENSION(:,:)         :: a_u_mat,b_u_mat,a_v_mat,b_v_mat,qmax_mat,qmin_mat,ecc_mat 
     755!      REAL(wp), ALLOCATABLE,DIMENSION(:,:)         :: thetamax_mat,thetamin_mat,Qc_mat,Qac_mat,gc_mat,gac_mat 
     756!      REAL(wp), ALLOCATABLE,DIMENSION(:,:)         :: Phi_Ua_mat,dir_Ua_mat,polarity_mat 
     757 
     758 
     759 
     760      IF (ln_diaharm_postproc_vel .AND. ln_ana_uvbar)  THEN 
     761         ALLOCATE( amp_u2d(jh,jpi,jpj),amp_v2d(jh,jpi,jpj),phi_u2d(jh,jpi,jpj),phi_v2d(jh,jpi,jpj) ) 
     762 
     763 
     764         ALLOCATE(tmp_u_amp_mat(jpi,jpj),tmp_v_amp_mat(jpi,jpj),tmp_u_phi_mat(jpi,jpj),tmp_v_phi_mat(jpi,jpj)) 
     765!         ALLOCATE(a_u_mat(jpi,jpj),b_u_mat(jpi,jpj),a_v_mat(jpi,jpj),b_v_mat(jpi,jpj)) 
     766!         ALLOCATE(qmax_mat(jpi,jpj),qmin_mat(jpi,jpj),ecc_mat(jpi,jpj)) 
     767!         ALLOCATE(thetamax_mat(jpi,jpj),thetamin_mat(jpi,jpj),Qc_mat(jpi,jpj),Qac_mat(jpi,jpj)) 
     768!         ALLOCATE(gc_mat(jpi,jpj),gac_mat(jpi,jpj),Phi_Ua_mat(jpi,jpj),dir_Ua_mat(jpi,jpj),polarity_mat(jpi,jpj)) 
     769 
     770      endif 
    744771 
    745772      do jgrid=1,nvar_2d 
     
    796823 
    797824 
     825 
     826             IF (ln_diaharm_postproc_vel .AND. ln_ana_uvbar)  THEN 
     827 
     828               !IF (m_posi_2d(jgrid) == 2) THEN 
     829               IF (TRIM(suffix) == TRIM('u2d')) THEN 
     830                  if (lwp)  WRITE(numout,*) "harm_ana_out ln_diaharm_postproc_vel: "//TRIM(Wave(ntide_all(jh))%cname_tide)//' u2d  '//TRIM(suffix) 
     831                  amp_u2d(jh,:,:) = h_out2D(:,:) 
     832                  phi_u2d(jh,:,:) = rpi*g_out2D(:,:)/180.0 
     833               ENDIF 
     834 
     835               !IF (m_posi_2d(jgrid) == 3) THEN 
     836               IF (TRIM(suffix) == TRIM('v2d')) THEN 
     837                  if (lwp)  WRITE(numout,*) "harm_ana_out ln_diaharm_postproc_vel: "//TRIM(Wave(ntide_all(jh))%cname_tide)//' v2d  '//TRIM(suffix) 
     838                  amp_v2d(jh,:,:) = h_out2D(:,:) 
     839                  phi_v2d(jh,:,:) = rpi*g_out2D(:,:)/180.0 
     840               ENDIF 
     841             ENDIF 
    798842 
    799843             CALL FLUSH(numout) 
     
    885929     CALL FLUSH(numout) 
    886930 
     931      IF (ln_diaharm_postproc_vel .AND. ln_ana_uvbar)  THEN 
     932         IF(lwp) WRITE(numout,*) "diaharm_fast: Postprocess barotropic velocity tidal parameters" 
     933         CALL FLUSH(numout) 
     934         DO jh=1,nb_ana 
     935 
     936 
     937            tmp_u_amp_mat(:,:) = 0. 
     938            tmp_v_amp_mat(:,:) = 0. 
     939            tmp_u_phi_mat(:,:) = 0. 
     940            tmp_v_phi_mat(:,:) = 0. 
     941 
     942!            a_u_mat(:,:) = 0. 
     943!            b_u_mat(:,:) = 0. 
     944!            a_v_mat(:,:) = 0. 
     945!            b_v_mat(:,:) = 0. 
     946 
     947!            qmax_mat(:,:) = 0. 
     948!            qmin_mat(:,:) = 0. 
     949 
     950!            ecc_mat(:,:) = 0 
     951!            thetamax_mat(:,:) =0. 
     952!            thetamin_mat(:,:) = 0. 
     953 
     954!            Qc_mat(:,:) = 0. 
     955!            Qac_mat(:,:) = 0. 
     956!            gc_mat(:,:) = 0. 
     957!            gac_mat(:,:) = 0. 
     958 
     959!            Phi_Ua_mat(:,:) = 0. 
     960!            dir_Ua_mat(:,:) = 0. 
     961!            polarity_mat(:,:) = 0. 
     962 
     963 
     964!             DO jj = 2, nlcj - 1 
     965!                DO ji = 2, nlci - 1 
     966 
     967!             do jj=2,nlcj 
     968!                do ji=2,nlci 
     969                    !IF ((ssumask(ji,jj) + ssumask(ji-1,jj)) == 0 ) CYCLE 
     970                    !IF ((ssvmask(ji,jj) + ssvmask(ji,jj-1)) == 0 ) CYCLE 
     971 
     972!                    IF ( ((ssumask(ji,jj) + ssumask(ji-1,jj)) > 0 ) .AND. ((ssvmask(ji,jj) + ssvmask(ji,jj-1)) > 0 ) ) THEN 
     973!                        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)) 
     974!                        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)) 
     975!                        ! WORK ON THE WRAP AROUND 
     976!                        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)) 
     977!                        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)) 
     978 
     979             do jj=1,nlcj 
     980                do ji=1,nlci 
     981 
     982!                        tmp_u_amp = ((amp_u2d(jh,ji,jj)) + (amp_u2d(jh,ji-1,jj)))/(2.) 
     983!                        tmp_v_amp = ((amp_v2d(jh,ji,jj)) + (amp_v2d(jh,ji,jj-1)))/(2.) 
     984!                        ! WORK ON THE WRAP AROUND 
     985!                        tmp_u_phi = ((phi_u2d(jh,ji,jj)) + (phi_u2d(jh,ji-1,jj)))/(2.) 
     986!                        tmp_v_phi = ((phi_v2d(jh,ji,jj)) + (phi_v2d(jh,ji,jj-1)))/(2.) 
     987 
     988 
     989 
     990                        tmp_u_amp = (amp_u2d(jh,ji,jj))  
     991                        tmp_v_amp = (amp_v2d(jh,ji,jj))  
     992                        ! WORK ON THE WRAP AROUND 
     993                        tmp_u_phi = (phi_u2d(jh,ji,jj))  
     994                        tmp_v_phi = (phi_v2d(jh,ji,jj))  
     995 
     996 
     997 
     998!                        a_u = tmp_U_amp * cos(tmp_U_phi) 
     999!                        b_u = tmp_U_amp * sin(tmp_U_phi) 
     1000!                        a_v = tmp_V_amp * cos(tmp_V_phi) 
     1001!                        b_v = tmp_V_amp * sin(tmp_V_phi) 
     1002 
     1003!                        twodelta =  atan2( (tmp_V_amp**2  * sin( 2*(tmp_U_phi - tmp_V_phi)  ) ) , (   tmp_U_amp**2   +   tmp_V_amp**2  * cos( 2*(tmp_U_phi - tmp_V_phi)  )     ) ) 
     1004!                        delta = twodelta/2. 
     1005 
     1006!                        !alpha2 = sqrt( tmp_U_amp**4 + tmp_V_amp**4 + 2*tmp_U_amp**2*tmp_V_amp**2*cos(2*(tmp_U_phi - tmp_V_phi))  ) 
     1007 
     1008!                        tmpreal = tmp_U_amp**4 + tmp_V_amp**4 + 2*tmp_U_amp**2*tmp_V_amp**2*cos(2*(tmp_U_phi - tmp_V_phi))  
     1009!                        if (tmpreal < 0) CYCLE 
     1010!                        alpha2 = sqrt( tmp_U_amp**4 + tmp_V_amp**4 + 2*tmp_U_amp**2*tmp_V_amp**2*cos(2*(tmp_U_phi - tmp_V_phi))  ) 
     1011!                        if (alpha2 < 0) CYCLE 
     1012!                        alpha= sqrt( alpha2 ) 
     1013 
     1014 
     1015!                        !major and minor axis of the ellipse 
     1016!                        !qmax = sqrt( (tmp_U_amp**2 + tmp_V_amp**2 + alpha**2)/2 ) 
     1017!                        !tmpreal =  (tmp_U_amp**2 + tmp_V_amp**2 - alpha**2)/2 
     1018!                        !qmin = 0 
     1019!                        !if (tmpreal > 0) qmin = sqrt( (tmp_U_amp**2 + tmp_V_amp**2 - alpha**2)/2 )   ! but always positive. 
     1020 
     1021!                        tmpreal =  (tmp_U_amp**2 + tmp_V_amp**2 - alpha**2)/2 
     1022!                        if (tmpreal < 0) CYCLE 
     1023!                        qmin = sqrt( (tmp_U_amp**2 + tmp_V_amp**2 - alpha**2)/2 )   ! but always positive. 
     1024 
     1025!                        !eccentricity of ellipse 
     1026!                        ecc = (qmax - qmin)/(qmax + qmin) 
     1027!                        ! Angle of major and minor ellipse 
     1028!                        thetamax = atan2((  tmp_V_amp * cos((tmp_U_phi - tmp_V_phi) - delta)   ) , ( tmp_U_amp * cos( delta) )  ) 
     1029!                        thetamin = thetamax + rpi/2. 
     1030 
     1031 
     1032 
     1033!                        ! Rotary current components: Pugh A3.10 
     1034!                        ! Clockwise (c) and anticlockwise (ac) rotating rotate_wind_vectors 
     1035!                        ! so   Qc = clockwise     = anticyclonic = negative 
     1036!                        ! and Qac = anticlockwise = cyclonic     = negative 
     1037 
     1038!                        tmpreal = tmp_U_amp**2 + tmp_V_amp**2 - (2*tmp_U_amp*tmp_V_amp*sin( tmp_V_phi - tmp_U_phi)) 
     1039!                        if (tmpreal < 0) CYCLE 
     1040!                        Qc  = 0.5*sqrt( tmp_U_amp**2 + tmp_V_amp**2 - (2*tmp_U_amp*tmp_V_amp*sin( tmp_V_phi - tmp_U_phi))  ) 
     1041 
     1042!                        tmpreal = tmp_U_amp**2 + tmp_V_amp**2 + (2*tmp_U_amp*tmp_V_amp*sin( tmp_V_phi - tmp_U_phi))  
     1043!                        if (tmpreal < 0) CYCLE 
     1044!                        Qac = 0.5*sqrt( tmp_U_amp**2 + tmp_V_amp**2 + (2*tmp_U_amp*tmp_V_amp*sin( tmp_V_phi - tmp_U_phi))  ) 
     1045 
     1046 
     1047!                        gc  = atan2(  (  (  tmp_U_amp*sin( tmp_U_phi ) ) +  (tmp_V_amp*cos( tmp_V_phi)  ) )  ,  (  (tmp_U_amp*cos( tmp_U_phi ))  -  (tmp_V_amp*sin( tmp_V_phi ))  )  ) 
     1048!                        gac = atan2(  (  ( -tmp_U_amp*sin( tmp_U_phi ) ) +  (tmp_V_amp*cos( tmp_V_phi)  ) )  ,  (  (tmp_U_amp*cos( tmp_U_phi ))  +  (tmp_V_amp*sin( tmp_V_phi ))  )  ) 
     1049 
     1050!                        !Pugh A3.2 
     1051!                        Phi_Ua = -0.5*(gac - gc) 
     1052!                        dir_Ua = 0.5*(gac + gc)  ! positive from x axis 
     1053!                        polarity = (Qac - Qc)/qmax 
     1054 
     1055 
     1056 
     1057                        tmp_u_amp_mat(ji,jj) = tmp_u_amp 
     1058                        tmp_v_amp_mat(ji,jj) = tmp_v_amp 
     1059                        tmp_u_phi_mat(ji,jj) = tmp_u_phi 
     1060                        tmp_v_phi_mat(ji,jj) = tmp_v_phi 
     1061 
     1062 
     1063!                        a_u_mat(ji,jj) = a_u 
     1064!                        b_u_mat(ji,jj) = b_u 
     1065!                        a_v_mat(ji,jj) = a_v 
     1066!                        b_v_mat(ji,jj) = b_v 
     1067 
     1068!                        qmax_mat(ji,jj) = qmax 
     1069!                        qmin_mat(ji,jj) = qmin 
     1070 
     1071!                        ecc_mat(ji,jj) = ecc 
     1072!                        thetamax_mat(ji,jj) = thetamax 
     1073!                        thetamin_mat(ji,jj) = thetamin 
     1074 
     1075!                        Qc_mat(ji,jj) = Qc 
     1076!                        Qac_mat(ji,jj) = Qac 
     1077!                        gc_mat(ji,jj) = gc 
     1078!                        gac_mat(ji,jj) = gac 
     1079 
     1080!                        Phi_Ua_mat(ji,jj) = Phi_Ua 
     1081!                        dir_Ua_mat(ji,jj) = dir_Ua 
     1082!                        polarity_mat(ji,jj) = polarity 
     1083 
     1084!                    ENDIF 
     1085                END DO 
     1086             END DO 
     1087 
     1088 
     1089!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_u_amp_t_uvbar' 
     1090!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1091!               IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1092!               CALL iom_put( TRIM(tmp_name), tmp_u_amp_mat(:,:)) 
     1093!            ENDIF 
     1094!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_v_amp_t_uvbar' 
     1095!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1096!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1097!              CALL iom_put( TRIM(tmp_name), tmp_v_amp_mat(:,:)) 
     1098!            ENDIF 
     1099!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_u_phi_t_uvbar' 
     1100!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1101!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1102!              CALL iom_put( TRIM(tmp_name), tmp_u_phi_mat(:,:)) 
     1103!            ENDIF 
     1104!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_v_phi_t_uvbar' 
     1105!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1106!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1107!              CALL iom_put( TRIM(tmp_name), tmp_v_phi_mat(:,:)) 
     1108!            ENDIF 
     1109 
     1110 
     1111 
     1112!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_a_u_uvbar' 
     1113!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1114!               IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1115!               CALL iom_put( TRIM(tmp_name), a_u_mat(:,:)) 
     1116!            ENDIF 
     1117!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_a_v_uvbar' 
     1118!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1119!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1120!              CALL iom_put( TRIM(tmp_name), a_v_mat(:,:)) 
     1121!            ENDIF 
     1122!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_b_u_uvbar' 
     1123!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1124!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1125!              CALL iom_put( TRIM(tmp_name), b_u_mat(:,:)) 
     1126!            ENDIF 
     1127!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_b_v_uvbar' 
     1128!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1129!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1130!              CALL iom_put( TRIM(tmp_name), b_v_mat(:,:)) 
     1131!            ENDIF 
     1132 
     1133!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_qmax_uvbar' 
     1134!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1135!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1136!              CALL iom_put( TRIM(tmp_name), qmax_mat(:,:)) 
     1137!            ENDIF 
     1138!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_qmin_uvbar' 
     1139!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1140!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1141!              CALL iom_put( TRIM(tmp_name), qmin_mat(:,:)) 
     1142!            ENDIF 
     1143 
     1144!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_ecc_uvbar' 
     1145!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1146!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1147!              CALL iom_put( TRIM(tmp_name), ecc_mat(:,:)) 
     1148!            ENDIF 
     1149!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_thetamax_uvbar' 
     1150!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1151!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1152!              CALL iom_put( TRIM(tmp_name), thetamax_mat(:,:)) 
     1153!            ENDIF 
     1154!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_thetamin_uvbar' 
     1155!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1156!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1157!              CALL iom_put( TRIM(tmp_name), thetamin_mat(:,:)) 
     1158!            ENDIF 
     1159 
     1160!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_Qc_uvbar' 
     1161!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1162!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1163!              CALL iom_put( TRIM(tmp_name), Qc_mat(:,:)) 
     1164!            ENDIF 
     1165!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_Qac_uvbar' 
     1166!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1167!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1168!              CALL iom_put( TRIM(tmp_name), Qac_mat(:,:)) 
     1169!            ENDIF 
     1170!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_gc_uvbar' 
     1171!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1172!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1173!              CALL iom_put( TRIM(tmp_name), gc_mat(:,:)) 
     1174!            ENDIF 
     1175!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_gac_uvbar' 
     1176!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1177!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1178!              CALL iom_put( TRIM(tmp_name), gac_mat(:,:)) 
     1179!            ENDIF 
     1180 
     1181 
     1182!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_Phi_Ua_uvbar' 
     1183!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1184!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1185!              CALL iom_put( TRIM(tmp_name), Phi_Ua_mat(:,:)) 
     1186!            ENDIF 
     1187!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_dir_Ua_uvbar' 
     1188!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1189!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1190!              CALL iom_put( TRIM(tmp_name), dir_Ua_mat(:,:)) 
     1191!            ENDIF 
     1192!            tmp_name=TRIM(Wave(ntide_all(jh))%cname_tide)//'_polarity_uvbar' 
     1193!            IF( iom_use(TRIM(tmp_name)) ) THEN 
     1194!              IF(lwp) WRITE(numout,*) "harm_ana_out: iom_put: ",TRIM(tmp_name) 
     1195!              CALL iom_put( TRIM(tmp_name), polarity_mat(:,:)) 
     1196!            ENDIF 
     1197 
     1198            tmp_u_amp_mat(:,:) = 0. 
     1199            tmp_v_amp_mat(:,:) = 0. 
     1200            tmp_u_phi_mat(:,:) = 0. 
     1201            tmp_v_phi_mat(:,:) = 0. 
     1202 
     1203!            a_u_mat(:,:) = 0. 
     1204!            b_u_mat(:,:) = 0. 
     1205!            a_v_mat(:,:) = 0. 
     1206!            b_v_mat(:,:) = 0. 
     1207 
     1208!            qmax_mat(:,:) = 0. 
     1209!            qmin_mat(:,:) = 0. 
     1210 
     1211!            ecc_mat(:,:) = 0 
     1212!            thetamax_mat(:,:) =0. 
     1213!            thetamin_mat(:,:) = 0. 
     1214 
     1215!            Qc_mat(:,:) = 0. 
     1216!            Qac_mat(:,:) = 0. 
     1217!            gc_mat(:,:) = 0. 
     1218!            gac_mat(:,:) = 0. 
     1219 
     1220!            Phi_Ua_mat(:,:) = 0. 
     1221!            dir_Ua_mat(:,:) = 0. 
     1222!            polarity_mat(:,:) = 0. 
     1223 
     1224 
     1225         END DO 
     1226         IF(lwp) WRITE(numout,*) "diaharm_fast: Finshed postprocessing 2d velocity tidal parameters" 
     1227      ENDIF 
     1228 
     1229     CALL FLUSH(numout) 
     1230 
     1231      IF (ln_diaharm_postproc_vel .AND. ln_ana_uv3d)  THEN 
     1232           IF(lwp) WRITE(numout,*) "diaharm_fast: Postprocess 3d velocity tidal parameters" 
     1233      ENDIF 
     1234 
     1235 
     1236     CALL FLUSH(numout) 
    8871237 
    8881238! to output tidal parameters, u and v on t grid 
     
    9011251 
    9021252 
     1253      IF (ln_diaharm_postproc_vel .AND. ln_ana_uvbar)  THEN 
     1254 
     1255         DEALLOCATE(amp_u2d, amp_v2d, phi_u2d, phi_v2d ) 
     1256 
     1257 
     1258         DEALLOCATE(tmp_u_amp_mat, tmp_v_amp_mat, tmp_u_phi_mat, tmp_v_phi_mat ) 
     1259!         DEALLOCATE(a_u_mat, b_u_mat, a_v_mat, b_v_mat, qmax_mat, qmin_mat, ecc_mat ) 
     1260!         DEALLOCATE(thetamax_mat, thetamin_mat, Qc_mat, Qac_mat, gc_mat, gac_mat ) 
     1261!         DEALLOCATE(Phi_Ua_mat, dir_Ua_mat, polarity_mat ) 
     1262 
     1263      endif 
     1264 
     1265      IF(lwp) WRITE(numout,*) "diaharm_fast: Deallocated 2d velocity tidal parameters" 
     1266 
     1267      CALL FLUSH(numout) 
     1268! 
    9031269   END SUBROUTINE harm_ana_out 
    9041270! 
Note: See TracChangeset for help on using the changeset viewer.