#include "wwm_functions.h" !********************************************************************** !* * !********************************************************************** SUBROUTINE GENERAL_OUTPUT USE WWM_HOTFILE_MOD USE DATAPOOL IMPLICIT NONE WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4,L5)') 'WRITING OUTPUT INTERNAL TIME', RTIME, MAIN%TMJD, OUT_HISTORY%TMJD-1.E-8, OUT_HISTORY%EMJD, (MAIN%TMJD .GE. OUT_HISTORY%TMJD-1.E-8) .AND. (MAIN%TMJD .LE. OUT_HISTORY%EMJD) ! ! The history output ! IF ( (MAIN%TMJD .GE. OUT_HISTORY%TMJD-1.E-8) .AND. (MAIN%TMJD .LE. OUT_HISTORY%EMJD)) THEN WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'WRITING OUTPUT INTERNAL TIME', RTIME, MAIN%TMJD, OUT_HISTORY%TMJD-1.E-8, OUT_HISTORY%EMJD CALL OUTPUT_HISTORY(RTIME*DAY2SEC,.FALSE.) OUT_HISTORY%TMJD = OUT_HISTORY%TMJD + OUT_HISTORY%DELT*SEC2DAY END IF ! ! The station output ! IF ( (MAIN%TMJD .GE. OUT_STATION%TMJD-1.E-8) .AND. (MAIN%TMJD .LE. OUT_STATION%EMJD)) THEN WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'WRITING OUTPUT INTERNAL TIME', RTIME, MAIN%TMJD, OUT_STATION%TMJD-1.E-8, OUT_STATION%EMJD CALL OUTPUT_STATION(RTIME*DAY2SEC,.FALSE.) OUT_STATION%TMJD = OUT_STATION%TMJD + OUT_STATION%DELT*SEC2DAY END IF ! ! The hotfile output ! IF (LHOTF) THEN IF ( (MAIN%TMJD .GE. HOTF%TMJD-1.E-8) .AND. (MAIN%TMJD .LE. HOTF%EMJD)) THEN WRITE(STAT%FHNDL,'("+TRACE...",A,F15.4)') 'WRITING HOTFILE INTERNAL TIME', RTIME FLUSH(STAT%FHNDL) CALL OUTPUT_HOTFILE HOTF%TMJD = HOTF%TMJD + HOTF%DELT*SEC2DAY END IF END IF ! ! The wavewatch III exports ! WRITE(STAT%FHNDL,*) 'Before LEXPORT_BOUC_WW3' FLUSH(STAT%FHNDL) IF (LEXPORT_BOUC_WW3) THEN WRITE(STAT%FHNDL,*) 'Before time test' WRITE(STAT%FHNDL,*) 'MAIN%TMJD=', MAIN%TMJD WRITE(STAT%FHNDL,*) 'OUT_BOUC_WW3%TMJD=', OUT_BOUC_WW3%TMJD WRITE(STAT%FHNDL,*) 'OUT_BOUC_WW3%EMJD=', OUT_BOUC_WW3%EMJD FLUSH(STAT%FHNDL) IF ( (MAIN%TMJD .GE. OUT_BOUC_WW3%TMJD-1.E-8) .AND. (MAIN%TMJD .LE. OUT_BOUC_WW3%EMJD)) THEN WRITE(STAT%FHNDL,*) 'After time test' FLUSH(STAT%FHNDL) ! CALL EXPORT_BOUC_WW3_FORMAT OUT_BOUC_WW3%TMJD = OUT_BOUC_WW3%TMJD + OUT_BOUC_WW3%DELT*SEC2DAY END IF END IF WRITE(STAT%FHNDL,*) 'Before LEXPORT_WIND_WW3' FLUSH(STAT%FHNDL) IF (LEXPORT_WIND_WW3) THEN WRITE(STAT%FHNDL,*) 'Before time test' FLUSH(STAT%FHNDL) IF ( (MAIN%TMJD .GE. OUT_WIND_WW3%TMJD-1.E-8) .AND. (MAIN%TMJD .LE. OUT_WIND_WW3%EMJD)) THEN WRITE(STAT%FHNDL,*) 'After time test' FLUSH(STAT%FHNDL) ! CALL EXPORT_WIND_WW3_FORMAT OUT_WIND_WW3%TMJD = OUT_WIND_WW3%TMJD + OUT_WIND_WW3%DELT*SEC2DAY END IF END IF WRITE(STAT%FHNDL,*) 'Before LEXPORT_CURR_WW3' FLUSH(STAT%FHNDL) IF (LEXPORT_CURR_WW3) THEN WRITE(STAT%FHNDL,*) 'Before time test' FLUSH(STAT%FHNDL) IF ( (MAIN%TMJD .GE. OUT_CURR_WW3%TMJD-1.E-8) .AND. (MAIN%TMJD .LE. OUT_CURR_WW3%EMJD)) THEN WRITE(STAT%FHNDL,*) 'After time test' FLUSH(STAT%FHNDL) ! CALL EXPORT_CURR_WW3_FORMAT OUT_CURR_WW3%TMJD = OUT_CURR_WW3%TMJD + OUT_CURR_WW3%DELT*SEC2DAY END IF END IF WRITE(STAT%FHNDL,*) 'Before LEXPORT_WALV_WW3' FLUSH(STAT%FHNDL) IF (LEXPORT_WALV_WW3) THEN WRITE(STAT%FHNDL,*) 'Before time test' FLUSH(STAT%FHNDL) IF ( (MAIN%TMJD .GE. OUT_WALV_WW3%TMJD-1.E-8) .AND. (MAIN%TMJD .LE. OUT_WALV_WW3%EMJD)) THEN WRITE(STAT%FHNDL,*) 'After time test' FLUSH(STAT%FHNDL) ! CALL EXPORT_WALV_WW3_FORMAT OUT_WALV_WW3%TMJD = OUT_WALV_WW3%TMJD + OUT_WALV_WW3%DELT*SEC2DAY END IF END IF ! ! The boundary output ! IF (BOUC_NETCDF_OUT_PARAM .or. BOUC_NETCDF_OUT_SPECTRA) THEN #ifdef NCDF IF ( (MAIN%TMJD .GE. OUT_BOUC%TMJD-1.E-8) .AND. (MAIN%TMJD .LE. OUT_BOUC%EMJD)) THEN WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'WRITING OUTPUT INTERNAL TIME', RTIME, MAIN%TMJD, OUT_BOUC%TMJD-1.E-8, OUT_BOUC%EMJD CALL WRITE_NETCDF_BOUNDARY OUT_BOUC%TMJD = OUT_BOUC%TMJD + OUT_BOUC%DELT*SEC2DAY END IF #else CALL WWM_ABORT('Need netcdf for the boundary output') #endif END IF ! ! The nesting ! IF (L_NESTING) THEN #ifdef NCDF CALL DO_NESTING_OPERATION #else CALL WWM_ABORT('Need netcdf for the nesting output') #endif END IF ! WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH GENERAL_OUTPUT' FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE WWM_OUTPUT( TIME, LINIT_OUTPUT ) USE DATAPOOL IMPLICIT NONE REAL(rkind), INTENT(IN) :: TIME LOGICAL, INTENT(IN) :: LINIT_OUTPUT CALL OUTPUT_HISTORY( TIME, LINIT_OUTPUT ) CALL OUTPUT_STATION( TIME, LINIT_OUTPUT ) OUT_HISTORY%TMJD = OUT_HISTORY%TMJD + OUT_HISTORY%DELT*SEC2DAY OUT_STATION%TMJD = OUT_STATION%TMJD + OUT_STATION%DELT*SEC2DAY WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH WWM OUTPUT' FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE OUTPUT_HISTORY( TIME, LINIT_OUTPUT ) USE DATAPOOL IMPLICIT NONE REAL(rkind), INTENT(IN) :: TIME LOGICAL, INTENT(IN) :: LINIT_OUTPUT SELECT CASE (VAROUT_HISTORY%IOUTP) CASE (0) ! Do nothing ... CASE (1) CALL OUTPUT_HISTORY_XFN( TIME, LINIT_OUTPUT ) CASE (2) #ifdef NCDF CALL OUTPUT_HISTORY_NC #else CALL WWM_ABORT('For History in netcdf, need netcdf!') #endif #ifdef DARKO CASE (3) CALL OUTPUT_HISTORY_SHP( TIME ) #endif CASE DEFAULT WRITE(DBG%FHNDL,*) 'IOUTP=', VAROUT_HISTORY%IOUTP CALL WWM_ABORT('WRONG NO OUTPUT SPECIFIED') END SELECT WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH OUTPUT_HISTORY' FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE OUTPUT_STATION( TIME, LINIT_OUTPUT ) USE DATAPOOL IMPLICIT NONE REAL(rkind), INTENT(IN) :: TIME LOGICAL, INTENT(IN) :: LINIT_OUTPUT CHARACTER(LEN=15) :: CTIME CALL MJD2CT(MAIN%TMJD, CTIME) IF ((DIMMODE .GT. 1) .and. LOUTS) THEN WRITE(STAT%FHNDL,*) 'WRITING STATION OUTPUT' SELECT CASE (VAROUT_STATION%IOUTP) CASE (0) ! Do nothing ... CASE (1) CALL OUTPUT_STE(CTIME, LINIT_OUTPUT) CASE (2) #ifdef NCDF CALL OUTPUT_STATION_NC #else CALL WWM_ABORT('STATION_NC: Need to compile with netcdf') #endif CASE DEFAULT CALL WWM_ABORT('WRONG NO STATION OUTPUT SPECIFIED') END SELECT END IF WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH OUTPUT_HISTORY STATION' FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE OUTPUT_HISTORY_XFN( TIME, LINIT_OUTPUT ) ! ! XFN TYPE OUTPUT ! USE DATAPOOL IMPLICIT NONE REAL(rkind), INTENT(IN) :: TIME ! Yes we really want kind=4 variables here. The xfn tools can read kind=4 only LOGICAL, INTENT(IN) :: LINIT_OUTPUT INTEGER :: IP LOGICAL :: DoAirSea #ifdef MPI_PARALL_GRID REAL(rkind) :: OUTT_GLOBAL(NP_GLOBAL,OUTVARS) REAL(rkind) :: OUTT(NP_GLOBAL,OUTVARS) REAL(rkind) :: CURR_GLOBAL(NP_GLOBAL,CURRVARS) REAL(rkind) :: CURR(NP_GLOBAL,CURRVARS) REAL(rkind) :: FORCE_GLOBAL(NP_GLOBAL,2) REAL(rkind) :: FORCE(NP_GLOBAL,2) REAL(rkind) :: WIND_GLOBAL(NP_GLOBAL,WINDVARS) REAL(rkind) :: WIND(NP_GLOBAL,WINDVARS) REAL(rkind) :: ITER_GLOBAL(NP_GLOBAL), ITER_LOCAL(MNP) REAL(rkind) :: ITERT(NP_GLOBAL) #else REAL(rkind) :: OUTT(MNP,OUTVARS) REAL(rkind) :: CURR(MNP,CURRVARS) REAL(rkind) :: WIND(MNP,WINDVARS) #endif REAL(rkind) :: ACLOC(MSC,MDC) REAL(rkind) :: OUTPARS(OUTVARS) REAL(rkind) :: CURRPARS(CURRVARS) REAL(rkind) :: WINDPARS(WINDVARS) CHARACTER(LEN=15) :: CTIME CALL MJD2CT(MAIN%TMJD, CTIME) DoAirSea=.FALSE. #ifdef MPI_PARALL_GRID OUTT_GLOBAL = zero OUTT = zero CURR_GLOBAL = zero CURR = zero WIND_GLOBAL = zero WIND = zero FORCE_GLOBAL = zero FORCE = zero #else OUTT = zero CURR = zero WIND = zero #endif ACLOC = zero OUTPARS = zero CURRPARS = zero WINDPARS = zero #ifdef MPI_PARALL_GRID IF (LQSTEA .AND. LCHKCONV) ITER_LOCAL = MyREAL(IP_IS_STEADY) #endif #ifdef MPI_PARALL_GRID DO IP = 1, MNP IF (DEP(IP) .GT. DMIN) THEN ACLOC(:,:) = AC2(:,:,IP) CALL INTPAR(IP, MSC, ACLOC, OUTPARS) CALL CURRPAR(IP, CURRPARS) CALL WINDPAR(IP, WINDPARS) IF (LMONO_OUT) OUTPARS(1) = OUTPARS(1) / SQRT(2.) ELSE OUTPARS = zero CURRPARS = zero WINDPARS = zero END IF OUTT(iplg(IP),:) = OUTPARS(:) CURR(iplg(IP),:) = CURRPARS(:) WIND(iplg(IP),:) = WINDPARS(:) FORCE(iplg(IP),:) = FORCEXY(IP,:) IF (LQSTEA) ITERT(iplg(IP)) = ITER_LOCAL(IP) END DO call mpi_reduce(OUTT,OUTT_GLOBAL,NP_GLOBAL*OUTVARS,rtype,MPI_SUM,0,comm,ierr) call mpi_reduce(CURR,CURR_GLOBAL,NP_GLOBAL*CURRVARS,rtype,MPI_SUM,0,comm,ierr) call mpi_reduce(WIND,WIND_GLOBAL,NP_GLOBAL*WINDVARS,rtype,MPI_SUM,0,comm,ierr) call mpi_reduce(FORCE,FORCE_GLOBAL,NP_GLOBAL*2,rtype,MPI_SUM,0,comm,ierr) IF (LQSTEA .AND. LCHKCONV) call mpi_reduce(ITERT,ITER_GLOBAL,NP_GLOBAL,rtype,MPI_SUM,0,comm,ierr) if(myrank==0) then do IP=1,NP_GLOBAL OUTT_GLOBAL(IP,:) = OUTT_GLOBAL(IP,:)*nwild_gb(IP) CURR_GLOBAL(IP,:) = CURR_GLOBAL(IP,:)*nwild_gb(IP) WIND_GLOBAL(IP,:) = WIND_GLOBAL(IP,:)*nwild_gb(IP) FORCE_GLOBAL(IP,:) = FORCE_GLOBAL(IP,:)*nwild_gb(IP) IF (LQSTEA .AND. LCHKCONV) ITER_GLOBAL(IP) =ITER_GLOBAL(IP) *nwild_gb(IP) enddo !IP endif !myrank IF (myrank == 0) THEN IF (LINIT_OUTPUT) THEN OPEN(OUT%FHNDL+1, FILE = 'ergzusw.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+2, FILE = 'erguvh.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+3, FILE = 'ergwind.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+4, FILE = 'ergtm02.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+5, FILE = 'erguvd.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+6, FILE = 'ergufric.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+7, FILE = 'ergtau.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+8, FILE = 'ergiter.bin' , FORM = 'UNFORMATTED') IF (DoAirSea) THEN OPEN(OUT%FHNDL+9, FILE = 'airsea.dat' , FORM = 'FORMATTED') END IF END IF WRITE(OUT%FHNDL+1) SNGL(TIME) !WRITE(OUT%FHNDL+1) (SNGL(FORCE_GLOBAL(IP,1)), SNGL(FORCE_GLOBAL(IP,2)), SNGL(OUTT_GLOBAL(IP,1)) , IP = 1, NP_GLOBAL) WRITE(OUT%FHNDL+1) (SNGL(OUTT_GLOBAL(IP,7)), SNGL(OUTT_GLOBAL(IP,8)), SNGL(OUTT_GLOBAL(IP,1)) , IP = 1, NP_GLOBAL) CALL FLUSH(OUT%FHNDL+1) WRITE(OUT%FHNDL+2) SNGL(TIME) !WRITE(OUT%FHNDL+2) (SNGL(CURR_GLOBAL(IP,1)), SNGL(CURR_GLOBAL(IP,2)), SNGL(ZETA_SETUP(IP)), IP = 1, NP_GLOBAL) WRITE(OUT%FHNDL+2) (SNGL(CURR_GLOBAL(IP,1)), SNGL(CURR_GLOBAL(IP,2)), SNGL(CURR_GLOBAL(IP,3)), IP = 1, NP_GLOBAL) FLUSH(OUT%FHNDL+2) WRITE(OUT%FHNDL+3) SNGL(TIME) WRITE(OUT%FHNDL+3) (SNGL(WIND_GLOBAL(IP,1)), SNGL(WIND_GLOBAL(IP,2)), SNGL(OUTT_GLOBAL(IP,10)) , IP = 1, NP_GLOBAL) FLUSH(OUT%FHNDL+3) WRITE(OUT%FHNDL+4) SNGL(TIME) WRITE(OUT%FHNDL+4) (SNGL(OUTT_GLOBAL(IP,1)), SNGL(OUTT_GLOBAL(IP,2)), SNGL(OUTT_GLOBAL(IP,3)) , IP = 1, NP_GLOBAL) FLUSH(OUT%FHNDL+4) WRITE(OUT%FHNDL+5) SNGL(TIME) WRITE(OUT%FHNDL+5) (SNGL(CURR_GLOBAL(IP,1)), SNGL(CURR_GLOBAL(IP,2)), SNGL(CURR_GLOBAL(IP,5)) , IP = 1, NP_GLOBAL) FLUSH(OUT%FHNDL+5) WRITE(OUT%FHNDL+6) SNGL(TIME) WRITE(OUT%FHNDL+6) (SNGL(WIND_GLOBAL(IP,9)), SNGL(WIND_GLOBAL(IP,8)), SNGL(WIND_GLOBAL(IP,7)) , IP = 1, NP_GLOBAL) FLUSH(OUT%FHNDL+6) WRITE(OUT%FHNDL+7) SNGL(TIME) WRITE(OUT%FHNDL+7) (SNGL(WIND_GLOBAL(IP,4)), SNGL(WIND_GLOBAL(IP,5)), SNGL(WIND_GLOBAL(IP,6)) , IP = 1, NP_GLOBAL) FLUSH(OUT%FHNDL+7) IF (LQSTEA .AND. LCHKCONV) THEN WRITE(OUT%FHNDL+8) SNGL(TIME) WRITE(OUT%FHNDL+8) (SNGL(ITER_GLOBAL(IP)), SNGL(ITER_GLOBAL(IP)), SNGL(ITER_GLOBAL(IP)) , IP = 1, NP_GLOBAL) FLUSH(OUT%FHNDL+8) ENDIF IF (DoAirSea) THEN DO IP = 1, NP_GLOBAL WRITE(OUT%FHNDL+9,'(10F15.6)') SNGL(WIND_GLOBAL(IP,:)) ENDDO FLUSH(OUT%FHNDL+9) END IF IF (LCFL) THEN WRITE(OUT%FHNDL+10) SNGL(TIME) WRITE(OUT%FHNDL+10) (SNGL(CFLCXY(1,IP)), SNGL(CFLCXY(2,IP)), SNGL(CFLCXY(3,IP)), IP = 1, MNP) ENDIF END IF ! myrank #else !$OMP DO PRIVATE (IP,ACLOC,OUTPARS,CURRPARS,WINDPARS) DO IP = 1, MNP OUTT(IP,:) = 0. IF (DEP(IP) .GT. DMIN) THEN ACLOC(:,:) = AC2(:,:,IP) CALL INTPAR(IP, MSC, ACLOC, OUTPARS) CALL CURRPAR(IP, CURRPARS) CALL WINDPAR(IP, WINDPARS) ELSE OUTPARS = 0. CURRPARS = 0. WINDPARS = 0. END IF OUTT(IP,:) = OUTPARS(:) CURR(IP,:) = CURRPARS(:) WIND(IP,:) = WINDPARS(:) END DO IF (LMONO_OUT) THEN !$OMP WORKSHARE OUTT(:,1) = OUTT(:,1) / SQRT(2.) !$OMP END WORKSHARE ENDIF !$OMP MASTER IF (LINIT_OUTPUT) THEN OPEN(OUT%FHNDL+1, FILE = 'ergzusw.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+2, FILE = 'erguvh.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+3, FILE = 'ergwind.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+4, FILE = 'ergchar.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+5, FILE = 'ergtm02.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+6, FILE = 'ergshallow.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+7, FILE = 'ergufric.bin' , FORM = 'UNFORMATTED') OPEN(OUT%FHNDL+8, FILE = 'ergtau.bin' , FORM = 'UNFORMATTED') IF (DoAirSea) THEN OPEN(OUT%FHNDL+9, FILE = 'airsea.dat' , FORM = 'FORMATTED') END IF OPEN(OUT%FHNDL+10, FILE = 'cflcxy.bin' , FORM = 'UNFORMATTED') END IF WRITE(OUT%FHNDL+1) SNGL(TIME) WRITE(OUT%FHNDL+1) (SNGL(OUTT(IP,7)), SNGL(OUTT(IP,8)), SNGL(OUTT(IP,1)), IP = 1, MNP) FLUSH(OUT%FHNDL+1) WRITE(OUT%FHNDL+2) SNGL(TIME) WRITE(OUT%FHNDL+2) (SNGL(CURR(IP,1)), SNGL(CURR(IP,2)), SNGL(DEP(IP)), IP = 1, MNP) FLUSH(OUT%FHNDL+2) WRITE(OUT%FHNDL+3) SNGL(TIME) WRITE(OUT%FHNDL+3) (SNGL(OUTT(IP,7)), SNGL(OUTT(IP,8)), SNGL(WIND(IP,3)), IP = 1, MNP) FLUSH(OUT%FHNDL+3) WRITE(OUT%FHNDL+4) SNGL(TIME) WRITE(OUT%FHNDL+4) (SNGL(UFRIC(IP)), SNGL(Z0(IP)), SNGL(ALPHA_CH(IP)), IP = 1, MNP) FLUSH(OUT%FHNDL+4) WRITE(OUT%FHNDL+5) SNGL(TIME) WRITE(OUT%FHNDL+5) (SNGL(OUTT(IP,1)), SNGL(OUTT(IP,2)), SNGL(OUTT(IP,3)), IP = 1, MNP) FLUSH(OUT%FHNDL+5) WRITE(OUT%FHNDL+6) SNGL(TIME) WRITE(OUT%FHNDL+6) (SNGL(OUTT(IP,1)), SNGL(OUTT(IP,2)), REAL(ISHALLOW(IP)), IP = 1, MNP) FLUSH(OUT%FHNDL+6) WRITE(OUT%FHNDL+7) SNGL(TIME) WRITE(OUT%FHNDL+7) (SNGL(WIND(IP,8)), SNGL(WIND(IP,9)), SNGL(WIND(IP,8)), IP = 1, MNP) FLUSH(OUT%FHNDL+7) IF (LQSTEA .AND. LCHKCONV) THEN WRITE(OUT%FHNDL+8) SNGL(TIME) WRITE(OUT%FHNDL+8) (REAL(IP_IS_STEADY(IP)), REAL(IP_IS_STEADY(IP)), REAL(IP_IS_STEADY(IP)) , IP = 1, NP_TOTAL) FLUSH(OUT%FHNDL+8) ENDIF IF (DoAirSea) THEN DO IP = 1, MNP WRITE(OUT%FHNDL+9,'(10F15.6)') SNGL(WIND(IP,:)) ENDDO FLUSH(OUT%FHNDL+9) END IF IF (LCFL) THEN WRITE(OUT%FHNDL+10) SNGL(TIME) WRITE(OUT%FHNDL+10) (SNGL(CFLCXY(1,IP)), SNGL(CFLCXY(2,IP)), SNGL(CFLCXY(3,IP)), IP = 1, MNP) ENDIF !$OMP END MASTER #endif WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH XFN_HISTORY' FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE PRINT_HS_TRIPLE(eX, eY) USE DATAPOOL implicit none REAL(rkind), intent(in) :: eX, eY REAL(rkind) :: HS, TM01, TM02, TM10, KLM, WLM REAL(rkind) :: X(3), Y(3), WI(3) REAL(rkind) :: HSinterp, HSinterpB, sumAC integer :: IP, I, ISMAX, IEfind REAL(rkind) :: ACLOC(MSC,MDC) REAL(rkind) :: XYTMP(2,MNP) XYTMP(1,:) = XP XYTMP(2,:) = YP IEfind=0 CALL FIND_ELE(MNE,MNP,INE,XYTMP,eX,eY,IEfind) DO I=1,3 IP=INE(I,IEfind) X(I)=XP(IP) Y(I)=YP(IP) END DO CALL INTELEMENT_COEF(X,Y,eX,eY,WI) HSinterp=0 HSinterpB=0 ISMAX=MSC sumAC=0 DO I=1,3 IP=INE(I,IEfind) ACLOC(:,:) = AC2(:,:,IP) CALL MEAN_PARAMETER(IP,ACLOC,ISMAX,HS,TM01,TM02,TM10,KLM,WLM) WRITE(DBG%FHNDL,*) 'IP=', IP, 'HS=', HS, 'wi=', WI(I) HSinterp=HSinterp+WI(I)*HS HSinterpB=HSinterpB + WI(I)*HS*HS sumAC=sumAC + WI(I)*sum(ACLOC) END DO HSinterpB=SQRT(HSinterpB) WRITE(DBG%FHNDL,*) 'HSinterp=', HSinterp, ' HS(b)=', HSinterpB WRITE(DBG%FHNDL,*) 'sumAC=', sumAC END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE OUTPUT_STE(CTIME,LINIT_OUTPUT) USE DATAPOOL IMPLICIT NONE CHARACTER(LEN=15), INTENT(IN) :: CTIME LOGICAL, INTENT(IN) :: LINIT_OUTPUT REAL(rkind) :: ACLOC(MSC,MDC), ACOUT_1D(MSC,3), ACOUT_2D(MSC*MDC) CHARACTER(LEN=20) :: TITLEFORMAT,OUTPUTFORMAT CHARACTER(LEN=2) :: CHRTMP character(len=256) :: FILEWRITE INTEGER :: I, IP, NI(3), IS LOGICAL :: ALIVE, LSAME REAL(rkind) :: WI(3) #ifdef MPI_PARALL_GRID REAL(rkind) :: TheIsumR #endif REAL(rkind) :: DEPLOC, WKLOC(MSC), CURTXYLOC(2) #ifndef MPI_PARALL_GRID REAL(rkind) :: WATLOC, ESUM #endif #ifndef MPI_PARALL_GRID REAL(rkind) :: USTARLOC, Z0LOC, ALPHALOC, WINDXLOC, WINDYLOC, CDLOC #endif WRITE(CHRTMP,'(I2)') OUTVARS TITLEFORMAT = '(A15,X,X,'//TRIM(CHRTMP)//'A15)' OUTPUTFORMAT = '(A15,X,X,'//TRIM(CHRTMP)//'F15.8)' LSAME = .FALSE. #ifndef MPI_PARALL_GRID DO I = 1, IOUTS ! Loop over stations ... IF (STATION(I)%IFOUND == 1) THEN STATION(I)%OUTPAR_NODE = 0. CALL INTELEMENT_AC_LOC(I,ACLOC,CURTXYLOC,DEPLOC,WATLOC,WKLOC) CALL INTPAR_LOC(I, STATION(I)%ISMAX,WKLOC,DEPLOC,CURTXYLOC,ACLOC,STATION(I)%OUTPAR_NODE) ! WRITE(DBG%FHNDL,*) 'HS=', STATION(I)%OUTPAR_NODE(1), 'sumAC=', sum(ACLOC) ! CALL PRINT_HS_TRIPLE(STATION(I)%XCOORD, STATION(I)%YCOORD) NI = INE(:,STATION(I)%ELEMENT) CALL INTELEMENT(XP(NI),YP(NI),UFRIC(NI), STATION(I)%XCOORD,STATION(I)%YCOORD,WI,USTARLOC,LSAME) CALL INTELEMENT(XP(NI),YP(NI),Z0(NI),STATION(I)%XCOORD,STATION(I)%YCOORD,WI,Z0LOC,LSAME) CALL INTELEMENT(XP(NI),YP(NI),ALPHA_CH(NI),STATION(I)%XCOORD,STATION(I)%YCOORD,WI,ALPHALOC,LSAME) CALL INTELEMENT(XP(NI),YP(NI),WINDXY(NI,1),STATION(I)%XCOORD,STATION(I)%YCOORD,WI,WINDXLOC,LSAME) CALL INTELEMENT(XP(NI),YP(NI),WINDXY(NI,2),STATION(I)%XCOORD,STATION(I)%YCOORD,WI,WINDYLOC,LSAME) CALL INTELEMENT(XP(NI),YP(NI),CD(NI),STATION(I)%XCOORD,STATION(I)%YCOORD,WI,CDLOC,LSAME) ELSE USTARLOC = 0. Z0LOC = 0. ALPHALOC = 0. WINDXLOC = 0. WINDYLOC = 0. CDLOC = 0. WKLOC = 0. DEPLOC = 0. CURTXYLOC = 0. ACLOC = 0. WATLOC = 0. END IF ACLOC_STATIONS(:,:,I)=ACLOC CDLOC_STATIONS(I)=CDLOC Z0LOC_STATIONS(I)=Z0LOC ALPHALOC_STATIONS(I)=ALPHALOC WINDXLOC_STATIONS(I)=WINDXLOC WINDYLOC_STATIONS(I)=WINDYLOC USTARLOC_STATIONS(I)=USTARLOC DEPLOC_STATIONS(I)=DEPLOC WKLOC_STATIONS(I,:)=WKLOC CURTXYLOC_STATIONS(I,:)=CURTXYLOC WATLEVLOC_STATIONS(I)=WATLOC STATION(I)%OUTPAR_NODE(26) = USTARLOC_STATIONS(I) STATION(I)%OUTPAR_NODE(27) = Z0LOC_STATIONS(I) STATION(I)%OUTPAR_NODE(28) = ALPHALOC_STATIONS(I) STATION(I)%OUTPAR_NODE(29) = WINDXLOC_STATIONS(I) STATION(I)%OUTPAR_NODE(30) = WINDYLOC_STATIONS(I) STATION(I)%OUTPAR_NODE(31) = CDLOC_STATIONS(I) STATION(I)%OUTPAR_NODE(32) = CURTXYLOC_STATIONS(I,1) STATION(I)%OUTPAR_NODE(33) = CURTXYLOC_STATIONS(I,2) STATION(I)%OUTPAR_NODE(34) = DEPLOC_STATIONS(I) STATION(I)%OUTPAR_NODE(35) = WATLEVLOC_STATIONS(I) END DO ! #else ! DO I = 1, IOUTS ! Loop over stations ... all threads IF (STATION(I)%IFOUND .GT. 0) THEN CALL INTELEMENT_AC_LOC(I,ACLOC_STATIONS(:,:,I),CURTXYLOC_STATIONS(I,:),DEPLOC_STATIONS(I),WATLEVLOC_STATIONS(I),WKLOC_STATIONS(I,:)) NI = INE(:,STATION(I)%ELEMENT) CALL INTELEMENT(XP(NI),YP(NI),UFRIC(NI),STATION(I)%XCOORD, STATION(I)%YCOORD,WI,USTARLOC_STATIONS(I),LSAME) CALL INTELEMENT(XP(NI),YP(NI),Z0(NI),STATION(I)%XCOORD,STATION(I)%YCOORD,WI,Z0LOC_STATIONS(I),LSAME) CALL INTELEMENT(XP(NI),YP(NI),ALPHA_CH(NI),STATION(I)%XCOORD,STATION(I)%YCOORD,WI,ALPHALOC_STATIONS(I),LSAME) CALL INTELEMENT(XP(NI),YP(NI),WINDXY(NI,1),STATION(I)%XCOORD,STATION(I)%YCOORD,WI,WINDXLOC_STATIONS(I),LSAME) CALL INTELEMENT(XP(NI),YP(NI),WINDXY(NI,2),STATION(I)%XCOORD,STATION(I)%YCOORD,WI,WINDYLOC_STATIONS(I),LSAME) CALL INTELEMENT(XP(NI),YP(NI),CD(NI),STATION(I)%XCOORD,STATION(I)%YCOORD,WI,CDLOC_STATIONS(I),LSAME) ELSE ACLOC_STATIONS(:,:,I) = 0. DEPLOC_STATIONS(I) = 0. WKLOC_STATIONS(I,:) = 0. USTARLOC_STATIONS(I) = 0. Z0LOC_STATIONS(I) = 0. ALPHALOC_STATIONS(I) = 0. WINDXLOC_STATIONS(I) = 0. WINDYLOC_STATIONS(I) = 0. CDLOC_STATIONS(I) = 0. WATLEVLOC_STATIONS(I) = 0. CURTXYLOC_STATIONS(I,:) = 0. END IF END DO ! WRITE(STAT%FHNDL,*) 'DEPTH OF THE FOUND STATIONS', DEPLOC_STATIONS ! FLUSH(DBG%FHNDL) DEPLOC_SUM = 0. WATLEVLOC_SUM = 0. CURTXYLOC_SUM = 0. USTAR_SUM = 0. Z0_SUM = 0. ALPHA_SUM = 0. CD_SUM = 0. WINDX_SUM = 0. WINDY_SUM = 0. WKLOC_SUM = 0. ACLOC_SUM = 0. DO I = 1, IOUTS CALL MPI_REDUCE( DEPLOC_STATIONS(I),DEPLOC_SUM(I),1,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE( WATLEVLOC_STATIONS(I),WATLEVLOC_SUM(I),1,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE(CURTXYLOC_STATIONS(I,1),CURTXYLOC_SUM(I,1),1,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE(CURTXYLOC_STATIONS(I,2),CURTXYLOC_SUM(I,2),1,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE( USTARLOC_STATIONS(I),USTAR_SUM(I),1,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE( Z0LOC_STATIONS(I),Z0_SUM(I),1,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE( ALPHALOC_STATIONS(I),ALPHA_SUM(I),1,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE( CDLOC_STATIONS(I),CD_SUM(I),1,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE(WINDXLOC_STATIONS(I),WINDX_SUM(I),1,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE(WINDYLOC_STATIONS(I),WINDY_SUM(I),1,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE(WKLOC_STATIONS(I,:), WKLOC_SUM(I,:),MSC,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE(ACLOC_STATIONS(:,:,I),ACLOC_SUM(:,:,I),MSC*MDC,rtype,MPI_SUM,0,COMM,IERR) END DO IF (MYRANK == 0) THEN DO I = 1, IOUTS IF (STATION(I)%ISUM .EQ. 0) THEN DEPLOC_STATIONS(I) = -999. CURTXYLOC_STATIONS(I,:) = -999. STATION(I)%OUTPAR_NODE(1:OUTVARS) = -999. ACLOC_STATIONS(:,:,I) = -999. WKLOC_STATIONS(I,:) = -999. USTARLOC_STATIONS(I) = -999. ALPHALOC_STATIONS(I) = -999. Z0LOC_STATIONS(I) = -999. CDLOC_STATIONS(I) = -999. WINDXLOC_STATIONS(I) = -999. WINDYLOC_STATIONS(I) = -999. WRITE(DBG%FHNDL,*) 'STATION OUT OF MESH', I ELSE TheIsumR=MyREAL(STATION(I)%ISUM) DEPLOC_STATIONS(I) = DEPLOC_SUM(I) / TheIsumR CURTXYLOC_STATIONS(I,:) = CURTXYLOC_SUM(I,:) / TheIsumR CURTXYLOC_STATIONS(I,:) = CURTXYLOC_SUM(I,:) / TheIsumR WATLEVLOC_STATIONS(I) = WATLEVLOC_SUM(I) / TheIsumR WKLOC_STATIONS(I,:) = WKLOC_SUM(I,:) / TheIsumR ACLOC_STATIONS(:,:,I) = ACLOC_SUM(:,:,I) / TheIsumR USTARLOC_STATIONS(I) = USTAR_SUM(I) / TheIsumR Z0LOC_STATIONS(I) = Z0_SUM(I) / TheIsumR ALPHALOC_STATIONS(I) = USTAR_SUM(I) / TheIsumR CDLOC_STATIONS(I) = CD_SUM(I) / TheIsumR WINDXLOC_STATIONS(I) = WINDX_SUM(I) / TheIsumR WINDYLOC_STATIONS(I) = WINDY_SUM(I) / TheIsumR !WRITE(STAT%FHNDL,*) 'SUM BEFORE INTPAR', SUM(ACLOC_STATIONS(:,:,I)) CALL INTPAR_LOC(I ,STATION(I)%ISMAX,WKLOC_STATIONS(I,:), DEPLOC_STATIONS(I), CURTXYLOC_STATIONS(I,:), ACLOC_STATIONS(:,:,I), STATION(I)%OUTPAR_NODE) STATION(I)%OUTPAR_NODE(26) = USTARLOC_STATIONS(I) STATION(I)%OUTPAR_NODE(27) = Z0LOC_STATIONS(I) STATION(I)%OUTPAR_NODE(28) = ALPHALOC_STATIONS(I) STATION(I)%OUTPAR_NODE(29) = WINDXLOC_STATIONS(I) STATION(I)%OUTPAR_NODE(30) = WINDYLOC_STATIONS(I) STATION(I)%OUTPAR_NODE(31) = CDLOC_STATIONS(I) STATION(I)%OUTPAR_NODE(32) = CURTXYLOC_STATIONS(I,1) STATION(I)%OUTPAR_NODE(33) = CURTXYLOC_STATIONS(I,2) STATION(I)%OUTPAR_NODE(34) = DEPLOC_STATIONS(I) STATION(I)%OUTPAR_NODE(35) = WATLEVLOC_STATIONS(I) END IF END DO END IF #endif #ifdef MPI_PARALL_GRID IF (MYRANK == 0) THEN #endif DO I = 1, IOUTS ACLOC=ACLOC_STATIONS(:,:,I) ! WRITE(STAT%FHNDL,*) I, 'SUM ACLOC 1', SUM(ACLOC) WKLOC=WKLOC_STATIONS(I,:) DEPLOC=DEPLOC_STATIONS(I) CURTXYLOC=CURTXYLOC_STATIONS(I,:) FILEWRITE=TRIM(STATION(I)%NAME)//'.site' INQUIRE(FILE=FILEWRITE,EXIST=ALIVE) IF (LINIT_OUTPUT) THEN OPEN(OUTPARM%FHNDL,FILE=FILEWRITE, STATUS = 'UNKNOWN') WRITE(OUTPARM%FHNDL, TITLEFORMAT) 'TIME', OUTT_VARNAMES ELSE IF (ALIVE.eqv..false.) THEN CALL WWM_ABORT('Unexisting .site file please debug') ENDIF OPEN(OUTPARM%FHNDL,FILE=FILEWRITE, STATUS = 'OLD' , POSITION = 'APPEND') ENDIF WRITE(OUTPARM%FHNDL,OUTPUTFORMAT) CTIME, STATION(I)%OUTPAR_NODE(1:OUTVARS) FLUSH(OUTPARM%FHNDL) CLOSE(OUTPARM%FHNDL) IF (LSP1D .OR. LSP2D) THEN CALL CLSPEC( WKLOC, DEPLOC, CURTXYLOC, ACLOC, ACOUT_1D, ACOUT_2D ) END IF IF (LSP1D) THEN FILEWRITE=TRIM(STATION(I)%NAME)//'.sp1d' INQUIRE(FILE=FILEWRITE,EXIST=ALIVE) IF (LINIT_OUTPUT) THEN OPEN(OUTSP1D%FHNDL,FILE=FILEWRITE, STATUS = 'UNKNOWN') WRITE(OUTSP1D%FHNDL,*) MSC WRITE(OUTSP1D%FHNDL,*) MDC WRITE(OUTSP1D%FHNDL,*) SPSIG WRITE(OUTSP1D%FHNDL,*) SPDIR #ifdef MPI_PARALL_GRID WRITE(OUTSP1D%FHNDL,*) STATION(I)%ISUM #else WRITE(OUTSP1D%FHNDL,*) STATION(I)%IFOUND #endif ELSE IF (ALIVE.eqv..false.) THEN CALL WWM_ABORT('Unexisting .sp1d file please debug') ENDIF OPEN(OUTSP1D%FHNDL,FILE=FILEWRITE, STATUS = 'OLD' , POSITION = 'APPEND') END IF WRITE(OUTSP1D%FHNDL,*) CTIME WRITE(OUTSP1D%FHNDL,*) DEPLOC WRITE(OUTSP1D%FHNDL,*) CURTXYLOC DO IS = 1, MSC WRITE(OUTSP1D%FHNDL,'(F15.8,3F20.10)') SPSIG(IS)/PI2, ACOUT_1D(IS,1), ACOUT_1D(IS,2), ACOUT_1D(IS,3) END DO FLUSH(OUTSP1D%FHNDL) CLOSE(OUTSP1D%FHNDL) END IF IF (LSP2D) THEN FILEWRITE=TRIM(STATION(I)%NAME)//'.sp2d' INQUIRE(FILE=FILEWRITE,EXIST=ALIVE ) IF (LINIT_OUTPUT) THEN OPEN(OUTSP2D%FHNDL,FILE=FILEWRITE, STATUS = 'UNKNOWN', FORM = 'UNFORMATTED') WRITE(OUTSP2D%FHNDL) MSC WRITE(OUTSP2D%FHNDL) MDC WRITE(OUTSP2D%FHNDL) SPSIG WRITE(OUTSP2D%FHNDL) SPDIR #ifdef MPI_PARALL_GRID WRITE(OUTSP2D%FHNDL) STATION(I)%ISUM #else WRITE(OUTSP2D%FHNDL) STATION(I)%IFOUND #endif ELSE IF (ALIVE.eqv..false.) THEN CALL WWM_ABORT('Unexisting .sp2d file please debug') ENDIF OPEN(OUTSP2D%FHNDL,FILE=FILEWRITE, STATUS = 'OLD' , POSITION = 'APPEND', FORM = 'UNFORMATTED') END IF WRITE(OUTSP2D%FHNDL) CTIME WRITE(OUTSP2D%FHNDL) DEPLOC WRITE(OUTSP2D%FHNDL) CURTXYLOC WRITE(OUTSP2D%FHNDL) ACLOC WRITE(OUTSP2D%FHNDL) ACOUT_2D FLUSH(OUTSP2D%FHNDL) CLOSE(OUTSP2D%FHNDL) END IF ! LSP2D END DO #ifdef MPI_PARALL_GRID END IF #endif WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH OUTPUT_STE' FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* The netcdf output outs the most variables and is the most * !* parametrizable. In order to add some new variables in output, one * !* needs to: * !* ---update OUTVAR_COMPLETE (wwm_datapl.F90) * !* ---update the reading of output parameter in * !* READ_HISTORY_STATION_NAMELIST (wwm_input.F90) * !* ---add full name and unit in NAMEVARIABLE (wwm_netcdf.F90) * !* ---add needed corrections in DETERMINE_NEEDED_COMPUTATION * !* (wwm_netcdf.F90) * !* ---add the commputation of the output variable in * !* PAR_COMPLETE (history) and PAR_COMPLETE_LOC (station) * !* ---wwminput.nmlref for the manual. * !********************************************************************** #ifdef NCDF SUBROUTINE OUTPUT_STATION_NC USE NETCDF USE DATAPOOL IMPLICIT NONE # ifdef MPI_PARALL_GRID REAL(rkind) :: OUTPAR_STATIONS_SUM(IOUTS,OUTVARS_COMPLETE) REAL(rkind) :: WK_STATIONS_SUM(IOUTS,MSC) REAL(rkind) :: AC_STATIONS_SUM(IOUTS,MSC,MDC) REAL(rkind), allocatable :: ACOUT_1D_STATIONS_SUM(:,:,:) REAL(rkind), allocatable :: ACOUT_2D_STATIONS_SUM(:,:,:) # endif REAL(rkind) :: OUTPAR_STATIONS(IOUTS,OUTVARS_COMPLETE) REAL(rkind) :: WK_STATIONS(IOUTS,MSC) REAL(rkind) :: AC_STATIONS(IOUTS,MSC,MDC) REAL(rkind), allocatable :: ACOUT_1D_STATIONS(:,:,:) REAL(rkind), allocatable :: ACOUT_2D_STATIONS(:,:,:) REAL(rkind) :: eTimeDay REAL(rkind) :: ACLOC(MSC,MDC) REAL(rkind) :: ACOUT_1D(MSC,3) REAL(rkind) :: ACOUT_2D(MSC,MDC) INTEGER :: LPOS character(len =256) :: FILE_NAME, PRE_FILE_NAME integer :: iret, ncid integer :: var_id integer :: I, irec_dim, IELOC, ISMAX character (len = *), parameter :: CallFct = "OUTPUT_STATION_NC" character (len = *), parameter :: UNITS = "units" character (len = *), parameter :: FULLNAME = "full-name" integer, save :: recs_stat integer, save :: recs_stat2 integer, save :: ifile = 1 logical, save :: IsInitDone = .FALSE. REAL(rkind) :: OUTPAR(OUTVARS_COMPLETE) character(len=40) :: eStr, eStrUnit character(len=80) :: eStrFullName REAL(rkind) :: WI(3) integer eInt(1) integer POSITION_BEFORE_POINT # ifdef MPI_PARALL_GRID REAL(rkind) :: TheIsumR # endif REAL(rkind) :: DEPLOC, WATLOC, WKLOC(MSC), CURTXYLOC(2) IF (VAROUT_STATION%ACOUT_1D.or.VAROUT_STATION%ACOUT_2D) THEN allocate(ACOUT_1D_STATIONS(IOUTS, MSC, 3), ACOUT_2D_STATIONS(IOUTS, MSC, MDC), stat=istat) IF (istat/=0) CALL WWM_ABORT('wwm_output, allocate error 1') ENDIF DO I = 1, IOUTS IF (STATION(I)%IFOUND == 1) THEN STATION(I)%OUTPAR_NODE = 0. CALL INTELEMENT_AC_LOC(I, ACLOC,CURTXYLOC, DEPLOC,WATLOC,WKLOC) IELOC=STATION(I)%ELEMENT ISMAX=STATION(I)%ISMAX WI=STATION(I)%WI(3) CALL PAR_COMPLETE_LOC(ISMAX, IELOC, WI,WKLOC, DEPLOC, CURTXYLOC, ACLOC, OUTPAR) IF (VAROUT_STATION%ACOUT_1D.or.VAROUT_STATION%ACOUT_2D) THEN CALL CLSPEC(WKLOC,DEPLOC,CURTXYLOC,ACLOC,ACOUT_1D,ACOUT_2D) END IF ELSE WKLOC = 0. ACLOC = 0. OUTPAR = 0. ACOUT_1D=0. ACOUT_2D=0. END IF OUTPAR_STATIONS(I,:) = OUTPAR WK_STATIONS(I,:) = WKLOC AC_STATIONS(I,:,:) = ACLOC IF (VAROUT_STATION%ACOUT_1D.or.VAROUT_STATION%ACOUT_2D) THEN ACOUT_1D_STATIONS(I,:,:)=ACOUT_1D ACOUT_2D_STATIONS(I,:,:)=ACOUT_2D END IF END DO # ifdef MPI_PARALL_GRID IF (MULTIPLEOUT_STAT.eq.0) THEN OUTPAR_STATIONS_SUM=0 WK_STATIONS_SUM=0 AC_STATIONS_SUM=0 IF (VAROUT_STATION%ACOUT_1D.or.VAROUT_STATION%ACOUT_2D) THEN allocate(ACOUT_1D_STATIONS_SUM(IOUTS,MSC,3), ACOUT_2D_STATIONS_SUM(IOUTS,MSC,MDC), stat=istat) IF (istat/=0) CALL WWM_ABORT('wwm_output, allocate error 2') ACOUT_1D_STATIONS_SUM=0 ACOUT_2D_STATIONS_SUM=0 END IF IF (IOUTS.gt.0) THEN CALL MPI_REDUCE(OUTPAR_STATIONS, OUTPAR_STATIONS_SUM, & & IOUTS*OUTVARS_COMPLETE, rtype,MPI_SUM,0,comm,ierr) CALL MPI_REDUCE(WK_STATIONS, WK_STATIONS_SUM, & & IOUTS*MSC, rtype,MPI_SUM,0,comm,ierr) CALL MPI_REDUCE(AC_STATIONS, AC_STATIONS_SUM, & & IOUTS*MSC*MDC, rtype,MPI_SUM,0,comm,ierr) IF (VAROUT_STATION%ACOUT_1D.or.VAROUT_STATION%ACOUT_2D) THEN CALL MPI_REDUCE(ACOUT_1D_STATIONS, ACOUT_1D_STATIONS_SUM, & & IOUTS*MSC*3, rtype,MPI_SUM,0,comm,ierr) CALL MPI_REDUCE(ACOUT_2D_STATIONS, ACOUT_2D_STATIONS_SUM, & & IOUTS*MSC*MDC, rtype,MPI_SUM,0,comm,ierr) END IF END IF DO I=1,IOUTS TheIsumR=MyREAL(STATION(I)%ISUM) !bug: if the stations are out of the domain we have division by zero OUTPAR_STATIONS(I,:)=OUTPAR_STATIONS_SUM(I,:)/TheIsumR WK_STATIONS(I,:) =WK_STATIONS_SUM(I,:)/TheIsumR AC_STATIONS(I,:,:) =AC_STATIONS_SUM(I,:,:)/TheIsumR IF (VAROUT_STATION%ACOUT_1D.or.VAROUT_STATION%ACOUT_2D) THEN ACOUT_1D_STATIONS(I,:,:)= & & ACOUT_1D_STATIONS_SUM(I,:,:)/TheIsumR ACOUT_2D_STATIONS(I,:,:)= & & ACOUT_2D_STATIONS_SUM(I,:,:)/TheIsumR ENDIF ENDDO IF (VAROUT_STATION%ACOUT_1D.or.VAROUT_STATION%ACOUT_2D) THEN deallocate(ACOUT_1D_STATIONS_SUM, ACOUT_2D_STATIONS_SUM) ENDIF ENDIF # endif DO I=1,IOUTS # ifdef MPI_PARALL_GRID IF (STATION(I)%ISUM .EQ. 0) THEN # else IF (STATION(I)%IFOUND .EQ. 0) THEN # endif OUTPAR_STATIONS(I,:)=-999. WK_STATIONS(I,:) =-999. AC_STATIONS(I,:,:) =-999. IF (VAROUT_STATION%ACOUT_1D.or.VAROUT_STATION%ACOUT_2D) THEN ACOUT_1D_STATIONS(I,:,:) =-999. ACOUT_2D_STATIONS(I,:,:) =-999. END IF END IF END DO eTimeDay=MAIN%TMJD LPOS=POSITION_BEFORE_POINT(OUT_STATION%FNAME) IF (OUT_STATION%IDEF.gt.0) THEN WRITE (PRE_FILE_NAME,10) OUT_STATION%FNAME(1:LPOS),ifile 10 FORMAT (a,'_',i4.4) ELSE WRITE (PRE_FILE_NAME,20) OUT_STATION%FNAME(1:LPOS) 20 FORMAT (a) ENDIF IF (MULTIPLEOUT_STAT.eq.0) THEN WRITE (FILE_NAME,30) TRIM(PRE_FILE_NAME) 30 FORMAT (a,'.nc') ELSE # ifdef MPI_PARALL_GRID WRITE (FILE_NAME,40) TRIM(PRE_FILE_NAME),myrank 40 FORMAT (a,'_',i4.4,'.nc') # endif ENDIF IF (IsInitDone.eqv..FALSE.) THEN ! At the beginning ... IsInitDone=.TRUE. recs_stat2=0 !$OMP MASTER IF (WriteOutputProcess_stat) THEN CALL DEFINE_STATION_NC(FILE_NAME, MULTIPLEOUT_STAT) ENDIF !$OMP END MASTER END IF IF (LMONO_OUT) THEN OUTPAR_STATIONS(:,1) = OUTPAR_STATIONS(:,1) / SQRT(2.) ENDIF recs_stat2=recs_stat2 + 1 IF (WriteOutputProcess_stat) THEN !$OMP MASTER iret=nf90_open(TRIM(FILE_NAME), nf90_write, ncid) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 29, iret) iret=nf90_inquire(ncid, unlimitedDimId = irec_dim) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 30, iret) iret=nf90_inquire_dimension(ncid, irec_dim,len = recs_stat) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 31, iret) recs_stat=recs_stat+1 IF (recs_stat.ne.recs_stat2) THEN CALL WWM_ABORT('There are more bugs to be solved (stat)'); !bug: must be the same bug like indicated above. If the stations are not in the domain this fails ... ENDIF #ifdef MPI_PARALL_GRID iret=nf90_inq_varid(ncid,'nproc',var_id) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 32, iret) eInt(1)=nproc iret=nf90_put_var(ncid,var_id,eInt,start = (/1/), count=(/1/)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 33, iret) #endif IF (VAROUT_STATION%AC) THEN iret=nf90_inq_varid(ncid, 'AC', var_id) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 34, iret) IF (NF90_RUNTYPE == NF90_OUTTYPE_STAT) THEN iret=nf90_put_var(ncid,var_id,AC_STATIONS, & & start = (/1,1,1,recs_stat/), count=(/IOUTS,MSC,MDC,1/)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 35, iret) ELSE iret=nf90_put_var(ncid,var_id,SNGL(AC_STATIONS), & & start = (/1,1,1,recs_stat/), count=(/IOUTS,MSC,MDC,1/)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 36, iret) ENDIF END IF IF (VAROUT_STATION%WK) THEN iret=nf90_inq_varid(ncid, 'WK', var_id) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 37, iret) IF (NF90_RUNTYPE == NF90_OUTTYPE_STAT) THEN iret=nf90_put_var(ncid,var_id,WK_STATIONS, & & start = (/1,1,recs_stat/), count=(/IOUTS,MSC,1/)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 38, iret) ELSE iret=nf90_put_var(ncid,var_id,SNGL(WK_STATIONS), & & start = (/1,1,recs_stat/), count=(/IOUTS,MSC,1/)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 39, iret) ENDIF END IF IF (VAROUT_STATION%ACOUT_1D) THEN iret=nf90_inq_varid(ncid, 'ACOUT_1D', var_id) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 40, iret) IF (NF90_RUNTYPE == NF90_OUTTYPE_STAT) THEN iret=nf90_put_var(ncid,var_id,ACOUT_1D_STATIONS, & & start = (/1,1,1,recs_stat/), count=(/IOUTS,MSC,3,1/)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 41, iret) ELSE iret=nf90_put_var(ncid,var_id,SNGL(ACOUT_1D_STATIONS), & & start = (/1,1,1,recs_stat/), count=(/IOUTS,MSC,3,1/)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 42, iret) ENDIF END IF IF (VAROUT_STATION%ACOUT_2D) THEN iret=nf90_inq_varid(ncid, 'ACOUT_2D', var_id) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 43, iret) IF (NF90_RUNTYPE == NF90_OUTTYPE_STAT) THEN iret=nf90_put_var(ncid,var_id,ACOUT_2D_STATIONS, & & start = (/1,1,1,recs_stat/), count=(/IOUTS,MSC,MDC,1/)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 44, iret) ELSE iret=nf90_put_var(ncid,var_id,SNGL(ACOUT_2D_STATIONS), & & start = (/1,1,1,recs_stat/), count=(/IOUTS,MSC,MDC,1/)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 45, iret) ENDIF END IF DO I=1,OUTVARS_COMPLETE IF (VAROUT_STATION%LVAR(I)) THEN CALL NAMEVARIABLE(I, eStr, eStrFullName, eStrUnit) iret=nf90_inq_varid(ncid, TRIM(eStr), var_id) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 46, iret) IF (NF90_RUNTYPE == NF90_OUTTYPE_STAT) THEN iret=nf90_put_var(ncid,var_id,OUTPAR_STATIONS(:,I), & & start = (/1, recs_stat/), count = (/ IOUTS, 1 /)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 47, iret) ELSE iret=nf90_put_var(ncid,var_id,SNGL(OUTPAR_STATIONS(:,I)), & & start = (/1, recs_stat/), count = (/ IOUTS, 1 /)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 48, iret) ENDIF END IF END DO CALL WRITE_NETCDF_TIME(ncid, recs_stat, eTimeDay) !write(DBG%FHNDL,*) 'Writing netcdf station record recs_stat=',recs_stat iret=nf90_close(ncid) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 49, iret) !$OMP END MASTER ENDIF IF (OUT_STATION%IDEF.gt.0) THEN IF (recs_stat2.eq.OUT_STATION%IDEF) THEN ifile=ifile+1 IsInitDone = .FALSE. ENDIF ENDIF IF (VAROUT_STATION%ACOUT_1D.or.VAROUT_STATION%ACOUT_2D) THEN deallocate(ACOUT_1D_STATIONS, ACOUT_2D_STATIONS) ENDIF END SUBROUTINE #endif !********************************************************************** !* * !********************************************************************** SUBROUTINE OUTPUT_LINE(CTIME,LINIT_OUTPUT) USE DATAPOOL IMPLICIT NONE CHARACTER(LEN=15), INTENT(IN) :: CTIME LOGICAL, INTENT(IN) :: LINIT_OUTPUT REAL(rkind) :: ACLOC(MSC,MDC), ACOUT_1D(MSC,3), ACOUT_2d(MSC*MDC) REAL(rkind) :: TheIsumR CHARACTER(LEN=20) :: TITLEFORMAT,OUTPUTFORMAT CHARACTER(LEN=2) :: CHRTMP INTEGER :: I, IS LOGICAL :: ALIVE #ifndef MPI_PARALL_GRID REAL(rkind) :: DEPLOC_STATION, WATLEVLOC_STATION, WKLOC_STATION(MSC), CURTXYLOC_STATION(2), ESUM #endif WRITE(CHRTMP,'(I2)') 27 TITLEFORMAT = '(A15,X,X,'//TRIM(CHRTMP)//'A10)' OUTPUTFORMAT = '(A15,X,X,'//TRIM(CHRTMP)//'F12.5)' #ifndef MPI_PARALL_GRID DO I = 1, IOUTS ! Loop over stations ... CALL INTELEMENT_AC_LOC(I, ACLOC,CURTXYLOC_STATION, DEPLOC_STATION, WATLEVLOC_STATION,WKLOC_STATION) CALL INTPAR_LOC(I, STATION(I)%ISMAX,WKLOC_STATION, DEPLOC_STATION,CURTXYLOC_STATION,ACLOC,STATION(I)%OUTPAR_NODE) !CALL INTELEMENT_WW3GLOBAL_LOC(STATION(I)%ELEMENT,STATION(I)%XCOORD,STATION(I)%YCOORD,WW3LOCAL) INQUIRE(FILE=TRIM(STATION(I)%NAME)//'.site',EXIST=ALIVE) IF (ALIVE .AND. .NOT. LINIT_OUTPUT) THEN OPEN(OUTPARM%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.site', STATUS = 'OLD' , POSITION = 'APPEND') ELSE OPEN(OUTPARM%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.site', STATUS = 'UNKNOWN') WRITE(OUTPARM%FHNDL, TITLEFORMAT) 'TIME', OUTT_VARNAMES END IF WRITE(OUTPARM%FHNDL,OUTPUTFORMAT) CTIME, STATION(I)%OUTPAR_NODE CLOSE(OUTPARM%FHNDL) IF (LSP1D .OR. LSP2D) THEN CALL CLSPEC( WKLOC_STATION, DEPLOC_STATION, CURTXYLOC_STATION, ACLOC, ACOUT_1d, ACOUT_2d ) END IF IF (LSP1D) THEN INQUIRE( FILE=TRIM(STATION(I)%NAME)//'.sp1d',EXIST=ALIVE) IF (ALIVE .AND. .NOT. LINIT_OUTPUT) THEN OPEN(OUTSP1D%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.sp1d', STATUS = 'OLD' , POSITION = 'APPEND') ELSE OPEN(OUTSP1D%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.sp1d', STATUS = 'UNKNOWN') WRITE(OUTSP1D%FHNDL,*) MSC, MDC WRITE(OUTSP1D%FHNDL,*) SPSIG, SPDIR, STATION(I)%IFOUND END IF WRITE(OUTSP1D%FHNDL,*) CTIME, WKLOC_STATION,DEPLOC_STATION, CURTXYLOC_STATION DO IS = 1, MSC WRITE(OUTSP1D%FHNDL,'(F15.8,3F20.10)') SPSIG(IS)/PI2, ACOUT_1D(IS,1), ACOUT_1D(IS,2), ACOUT_1D(IS,3) END DO CLOSE(OUTSP1D%FHNDL) END IF IF (LSP2D) THEN INQUIRE(FILE=TRIM(STATION(I)%NAME)//'.sp2d',EXIST=ALIVE) IF (ALIVE .AND. .NOT. LINIT_OUTPUT) THEN OPEN(OUTSP2D%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.sp2d', STATUS = 'OLD' , POSITION = 'APPEND', FORM = 'UNFORMATTED') ELSE OPEN(OUTSP2D%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.sp2d', STATUS = 'UNKNOWN', FORM = 'UNFORMATTED') WRITE(OUTSP2D%FHNDL) MSC, MDC WRITE(OUTSP2D%FHNDL) SPSIG, SPDIR, STATION(I)%IFOUND END IF WRITE(OUTSP2D%FHNDL) CTIME, WKLOC_STATION, DEPLOC_STATION, CURTXYLOC_STATION WRITE(OUTSP2D%FHNDL) ACLOC, ACOUT_2D CLOSE(OUTSP2D%FHNDL) END IF ! LSP2D END DO ! IOUTS ! #else ! DO I = 1, IOUTS ! Loop over stations ... IF (STATION(I)%IFOUND .EQ. 0) CYCLE CALL INTELEMENT_AC_LOC(I, ACLOC_STATIONS(:,:,I), CURTXYLOC_STATIONS(I,:),DEPLOC_STATIONS(I), WATLEVLOC_STATIONS(I),WKLOC_STATIONS(I,:)) !WRITE(DBG%FHNDL,*) 'INTERPOLATED MYRANK =', MYRANK, I, DEPLOC(I), CURTXYLOC(I,:), SUM(WKLOC(I,:)), SUM(ACLOC_STATIONS(:,:,I)) END DO WRITE(DBG%FHNDL,*) 'DEPTH OF THE FOUND STATIONS LINE', DEPLOC_STATIONS CALL MPI_REDUCE(DEPLOC_STATIONS(:),DEPLOC_SUM(:),IOUTS,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE(DEPLOC_STATIONS(:),WATLEVLOC_SUM(:),IOUTS,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE(CURTXYLOC_STATIONS(:,1),CURTXYLOC_SUM(:,1),IOUTS,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE(CURTXYLOC_STATIONS(:,2),CURTXYLOC_SUM(:,2),IOUTS,rtype,MPI_SUM,0,COMM,IERR) DO I = 1, IOUTS CALL MPI_REDUCE(WKLOC_STATIONS(I,:),WKLOC_SUM(I,:),MSC,rtype,MPI_SUM,0,COMM,IERR) CALL MPI_REDUCE(ACLOC_STATIONS(:,:,I),ACLOC_SUM(:,:,I),MSC*MDC,rtype,MPI_SUM,0,COMM,IERR) END DO IF (MYRANK == 0) THEN DO I = 1, IOUTS INQUIRE(FILE=TRIM(STATION(I)%NAME)//'.site',EXIST=ALIVE ) IF (ALIVE .AND. .NOT. LINIT_OUTPUT) THEN OPEN(OUTPARM%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.site', STATUS = 'OLD' , POSITION = 'APPEND') ELSE OPEN(OUTPARM%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.site', STATUS = 'UNKNOWN') WRITE(OUTPARM%FHNDL, TITLEFORMAT) 'TIME', OUTT_VARNAMES END IF IF (STATION(I)%ISUM .EQ. 0) THEN DEPLOC_STATIONS(I) = -999. CURTXYLOC_STATIONS(I,:) = -999. STATION(I)%OUTPAR_NODE(1:24) = -999. ACLOC = -999. WKLOC_STATIONS = -999. WRITE(DBG%FHNDL,*) 'STATION OUT OF MESH', I ELSE TheIsumR=MyREAL(STATION(I)%ISUM) DEPLOC_STATIONS(I) = DEPLOC_SUM(I) / TheIsumR CURTXYLOC_STATIONS(I,:) = CURTXYLOC_SUM(I,:) / TheIsumR WKLOC_STATIONS(I,:) = WKLOC_SUM(I,:) / TheIsumR ACLOC = ACLOC_SUM(:,:,I) / TheIsumR CALL INTPAR_LOC(I ,STATION(I)%ISMAX,WKLOC_STATIONS(I,:), DEPLOC_STATIONS(I),CURTXYLOC_STATIONS(I,:),ACLOC, STATION(I)%OUTPAR_NODE) END IF WRITE(OUTPARM%FHNDL,OUTPUTFORMAT) CTIME, STATION(I)%OUTPAR_NODE(1:24), DEPLOC_STATIONS(I), CURTXYLOC_STATIONS(I,:) CLOSE(OUTPARM%FHNDL) IF (LSP1D .OR. LSP2D) THEN CALL CLSPEC( WKLOC_STATIONS(I,:), DEPLOC_STATIONS(I), CURTXYLOC_STATIONS(I,:), ACLOC, ACOUT_1d, ACOUT_2d ) END IF IF (LSP1D) THEN INQUIRE(FILE=TRIM(STATION(I)%NAME)//'.sp1d',EXIST=ALIVE) IF (ALIVE .AND. .NOT. LINIT_OUTPUT) THEN OPEN(OUTSP1D%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.sp1d',STATUS = 'OLD' , POSITION = 'APPEND') ELSE OPEN(OUTSP1D%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.sp1d',STATUS = 'UNKNOWN') WRITE(OUTSP1D%FHNDL,*) MSC, MDC WRITE(OUTSP1D%FHNDL,*) SPSIG, SPDIR, STATION(I)%ISUM END IF WRITE(OUTSP1D%FHNDL,*) CTIME, WKLOC_STATIONS(I,:), DEPLOC_STATIONS(I), CURTXYLOC_STATIONS(I,:) DO IS = 1, MSC WRITE(OUTSP1D%FHNDL,'(F15.8,3F20.10)') SPSIG(IS)/PI2, ACOUT_1D(IS,1), ACOUT_1D(IS,2), ACOUT_1D(IS,3) END DO CLOSE(OUTSP1D%FHNDL) END IF IF (LSP2D) THEN INQUIRE(FILE=TRIM(STATION(I)%NAME)//'.sp2d',EXIST=ALIVE) IF (ALIVE .AND. .NOT. LINIT_OUTPUT) THEN OPEN(OUTSP2D%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.sp2d', STATUS = 'OLD' , POSITION = 'APPEND', FORM = 'UNFORMATTED') ELSE OPEN(OUTSP2D%FHNDL,FILE=TRIM(STATION(I)%NAME)//'.sp2d', STATUS = 'UNKNOWN', FORM = 'UNFORMATTED') WRITE(OUTSP2D%FHNDL) MSC, MDC WRITE(OUTSP2D%FHNDL) SPSIG, SPDIR, STATION(I)%ISUM END IF WRITE(OUTSP2D%FHNDL) CTIME, WKLOC_STATIONS(I,:), DEPLOC_STATIONS(I), CURTXYLOC_STATIONS(I,:) WRITE(OUTSP2D%FHNDL) ACLOC, ACOUT_2D CLOSE(OUTSP2D%FHNDL) END IF ! LSP2D END DO ! IOUTS END IF ! myrank #endif RETURN END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE CURRPAR(IP, OUTPAR) USE DATAPOOL IMPLICIT NONE INTEGER, INTENT(IN) :: IP REAL(rkind) , INTENT(OUT) :: OUTPAR(CURRVARS) OUTPAR = 0. #ifdef SCHISM OUTPAR(1) = UU2(NVRT,IP) ! Current in X-direction OUTPAR(2) = VV2(NVRT,IP) ! Current in Y-direction OUTPAR(3) = ETA2(IP) ! Water Level OUTPAR(4) = ETA1(IP) ! Water Level in last time step OUTPAR(5) = MAX(ZERO,WLDEP(IP) + ETA2(IP)) ! Total water depth #else OUTPAR(1) = CURTXY(IP,1) ! Current in X-direction OUTPAR(2) = CURTXY(IP,2) ! Current in Y-direction OUTPAR(3) = WATLEV(IP) ! Water Level OUTPAR(4) = WATLEVOLD(IP) ! Water Level in last time step OUTPAR(5) = DEP(IP) ! Total water depth #endif RETURN END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE WINDPAR(IP,OUTPAR) USE DATAPOOL IMPLICIT NONE INTEGER , INTENT(IN) :: IP REAL(rkind), INTENT(OUT) :: OUTPAR(WINDVARS) OUTPAR = 0. OUTPAR(1) = WINDXY(IP,1) ! wind vector u10,x OUTPAR(2) = WINDXY(IP,2) ! wind vector u10,y OUTPAR(3) = SQRT(WINDXY(IP,1)**2.+WINDXY(IP,2)**2.) ! wind magnitutde u10 OUTPAR(4) = TAUW(IP) ! wave stress from the discrete part of the spectra OUTPAR(5) = TAUHF(IP) ! high freq. part of the waves. OUTPAR(6) = TAUTOT(IP) ! total stress of the wave OUTPAR(7) = Z0(IP) ! apparent rougnes lengths [m] OUTPAR(8) = UFRIC(IP) ! ustar [m/s] OUTPAR(9) = ALPHA_CH(IP) ! Charnock Parameter gz0/ustar**2 [-} OUTPAR(10)= CD(IP) ! Drag Coefficient ! WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH WINDPAR' ! FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE INTPAR(IP, ISMAX, ACLOC, OUTPAR) USE DATAPOOL IMPLICIT NONE INTEGER, INTENT(IN) :: IP, ISMAX REAL(rkind) , INTENT(IN) :: ACLOC(MSC,MDC) REAL(rkind) , INTENT(OUT) :: OUTPAR(OUTVARS) REAL(rkind) :: HS,TM01,TM02,TM10,KLM,WLM REAL(rkind) :: TPP,FPP,CPP,WNPP,CGPP,KPP,LPP,PEAKDSPR,PEAKD,DPEAK,TPPD,KPPD,CGPD,CPPD REAL(rkind) :: UBOT,ORBITAL,BOTEXPER,TMBOT,URSELL,ETOTS,ETOTC,DM,DSPR OUTPAR = 0. CALL MEAN_PARAMETER(IP,ACLOC,ISMAX,HS,TM01,TM02,TM10,KLM,WLM) OUTPAR(1) = HS ! Significant wave height OUTPAR(2) = TM01 ! Mean average period OUTPAR(3) = TM02 ! Zero down crossing period for comparison with buoy. OUTPAR(4) = TM10 ! Mean period of wave overtopping/run-up OUTPAR(5) = KLM ! Mean wave number OUTPAR(6) = WLM ! Mean wave length ! write(DBG%FHNDL,'(6F15.8)') outpar(1:6) CALL MEAN_DIRECTION_AND_SPREAD(IP,ACLOC,ISMAX,ETOTS,ETOTC,DM,DSPR) OUTPAR(7) = ETOTC ! Etot energy in horizontal direction OUTPAR(8) = ETOTS ! Etot energy in vertical direction OUTPAR(9) = DM ! Mean average energy transport direction OUTPAR(10) = DSPR ! Mean directional spreading CALL PEAK_PARAMETER(IP,ACLOC,ISMAX,FPP,TPP,CPP,WNPP,CGPP,KPP,LPP,PEAKDSPR,PEAKD,DPEAK,TPPD,KPPD,CGPD,CPPD) OUTPAR(11) = TPPD ! Discrete Peak Period OUTPAR(12) = TPP ! Peak period OUTPAR(13) = CPP ! Peak phase vel. OUTPAR(14) = WNPP ! Peak n-factor OUTPAR(15) = CGPP ! Peak group vel. OUTPAR(16) = KPP ! Peak wave number OUTPAR(17) = LPP ! Peak wave length. OUTPAR(18) = PEAKD ! Peak direction OUTPAR(19) = PEAKDSPR ! Peak directional spreading OUTPAR(20) = DPEAK ! Discrete peak direction CALL WAVE_CURRENT_PARAMETER(IP,ACLOC,UBOT,ORBITAL,BOTEXPER,TMBOT,'INTPAR') OUTPAR(21) = UBOT ! near bottom vel. OUTPAR(22) = ORBITAL ! Orbital vel. OUTPAR(23) = BOTEXPER ! Bottom excursion period. OUTPAR(24) = TMBOT ! near bottom period. IF (TPP .GT. THR) THEN CALL URSELL_NUMBER(HS,MyREAL(1)/TPP,DEP(IP),URSELL) OUTPAR(25) = URSELL ! Ursell number based on peak period ... ELSE OUTPAR(25) = ZERO ! Ursell number based on peak period ... ENDIF OUTPAR(26) = UFRIC(IP) ! Friction velocity OUTPAR(27) = Z0(IP) ! Roughness length OUTPAR(28) = ALPHA_CH(IP) ! Charnock coefficient OUTPAR(29) = CD(IP) ! Drag coefficient OUTPAR(30) = WINDXY(IP,1) ! windx OUTPAR(31) = WINDXY(IP,2) ! windy ! WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH INTPAR' ! FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE DEBUG_PRINT_HS_STATS USE DATAPOOL implicit none REAL(rkind) :: ACLOC(MSC,MDC) REAL(rkind) :: HS,TM01,TM02,TM10,KLM,WLM REAL(rkind) :: MaxHS, SumHS, AvgHS INTEGER IP, ISMAX MaxHS=ZERO SumHS=ZERO ISMAX=MSC DO IP=1,MNP ACLOC(:,:) = AC2(:,:,IP) CALL MEAN_PARAMETER(IP,ACLOC,ISMAX,HS,TM01,TM02,TM10,KLM,WLM) IF (HS.gt.MaxHS) THEN MaxHS=HS END IF SumHS=SumHS + HS END DO AvgHS=SumHS/MyREAL(MNP) WRITE(DBG%FHNDL,*) 'DEBUG AvgHS=', AvgHS, ' MaxHS=', MaxHS END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE PAR_COMPLETE(IP, ISMAX, ACLOC, OUTPAR) USE DATAPOOL IMPLICIT NONE INTEGER, INTENT(IN) :: IP, ISMAX REAL(rkind) , INTENT(IN) :: ACLOC(MSC,MDC) REAL(rkind) , INTENT(OUT) :: OUTPAR(OUTVARS_COMPLETE) REAL(rkind) :: HS,TM01,TM02,TM10,KLM,WLM REAL(rkind) :: TPP,FPP,CPP,WNPP,CGPP,KPP,LPP,PEAKDSPR,PEAKD,DPEAK,TPPD,KPPD,CGPD,CPPD REAL(rkind) :: UBOT,ORBITAL,BOTEXPER,TMBOT,URSELL,ETOTS,ETOTC,DM,DSPR REAL(rkind) :: STOKESSURFX,STOKESSURFY REAL(rkind) :: STOKESBAROX,STOKESBAROY REAL(rkind) :: STOKESBOTTX,STOKESBOTTY OUTPAR = 0. IF (VAROUT_HISTORY%ComputeMean) THEN CALL MEAN_PARAMETER(IP,ACLOC,ISMAX,HS,TM01,TM02,TM10,KLM,WLM) OUTPAR(1) = HS ! Significant wave height OUTPAR(2) = TM01 ! Mean average period OUTPAR(3) = TM02 ! Zero down crossing period for comparison with buoy. OUTPAR(4) = TM10 ! Mean period of wave overtopping/run-up OUTPAR(5) = KLM ! Mean wave number OUTPAR(6) = WLM ! Mean wave length END IF IF (VAROUT_HISTORY%ComputeDirSpread) THEN CALL MEAN_DIRECTION_AND_SPREAD(IP,ACLOC,ISMAX,ETOTS,ETOTC,DM,DSPR) OUTPAR(7) = ETOTC ! Etot energy in horizontal direction OUTPAR(8) = ETOTS ! Etot energy in vertical direction OUTPAR(9) = DM ! Mean average energy transport direction OUTPAR(10) = DSPR ! Mean directional spreading END IF IF (VAROUT_HISTORY%ComputePeak) THEN CALL PEAK_PARAMETER(IP,ACLOC,ISMAX,FPP,TPP,CPP,WNPP,CGPP,KPP,LPP,PEAKDSPR,PEAKD,DPEAK,TPPD,KPPD,CGPD,CPPD) OUTPAR(11) = TPPD ! Discrete Peak Period OUTPAR(12) = CPPD ! Discrete Peak speed OUTPAR(13) = KPPD ! Discrete Peak wave number OUTPAR(14) = CGPD ! Discrete Peak group speed OUTPAR(15) = TPP ! Peak period OUTPAR(16) = CPP ! Peak phase vel. OUTPAR(17) = WNPP ! Peak n-factor OUTPAR(18) = CGPP ! Peak group vel. OUTPAR(19) = KPP ! Peak wave number OUTPAR(20) = LPP ! Peak wave length. OUTPAR(21) = PEAKD ! Peak direction OUTPAR(22) = PEAKDSPR ! Peak directional spreading OUTPAR(23) = DPEAK ! Discrete peak direction END IF IF (VAROUT_HISTORY%ComputeCurr) THEN CALL WAVE_CURRENT_PARAMETER(IP,ACLOC,UBOT,ORBITAL,BOTEXPER,TMBOT,'PAR_COMPLETE') OUTPAR(24) = UBOT ! OUTPAR(25) = ORBITAL ! Orbital vel. OUTPAR(26) = BOTEXPER ! Bottom excursion period. OUTPAR(27) = TMBOT ! END IF IF (VAROUT_HISTORY%ComputeUrsell) THEN CALL URSELL_NUMBER(HS,MyREAL(1)/TPP,DEP(IP),URSELL) OUTPAR(28) = URSELL ! Uresell number based on peak period ... END IF OUTPAR(29) = UFRIC(IP) OUTPAR(30) = Z0(IP) OUTPAR(31) = ALPHA_CH(IP) OUTPAR(32) = WINDXY(IP,1) OUTPAR(33) = WINDXY(IP,2) OUTPAR(34) = CD(IP) OUTPAR(35) = CURTXY(IP,1) OUTPAR(36) = CURTXY(IP,2) OUTPAR(37) = WATLEV(IP) OUTPAR(38) = WATLEVOLD(IP) OUTPAR(39) = DEPDT(IP) OUTPAR(40) = DEP(IP) OUTPAR(41) = SQRT(WINDXY(IP,1)**2.+WINDXY(IP,2)**2.) OUTPAR(42) = TAUW(IP) OUTPAR(43) = TAUW(IP) OUTPAR(44) = TAUW(IP) OUTPAR(45) = TAUHF(IP) OUTPAR(46) = TAUTOT(IP) IF (VAROUT_HISTORY%ComputeStokes) THEN CALL STOKES_DRIFT_SURFACE_BAROTROPIC(IP,STOKESBOTTX, STOKESBOTTY,STOKESSURFX,STOKESSURFY,STOKESBAROX,STOKESBAROY) OUTPAR(47) = STOKESBOTTX OUTPAR(48) = STOKESBOTTY OUTPAR(49) = STOKESSURFX OUTPAR(50) = STOKESSURFY OUTPAR(51) = STOKESBAROX OUTPAR(52) = STOKESBAROY END IF OUTPAR(53) = RSXX(IP) OUTPAR(54) = RSXY(IP) OUTPAR(55) = RSYY(IP) IF (LCFL) THEN OUTPAR(56) = CFLCXY(1,IP) OUTPAR(57) = CFLCXY(2,IP) OUTPAR(58) = CFLCXY(3,IP) ENDIF #ifdef WWM_SETUP IF (LZETA_SETUP) THEN OUTPAR(59) = ZETA_SETUP(IP) END IF #endif END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE PAR_COMPLETE_LOC(ISMAX, IELOC, WI, WKLOC, DEPLOC, CURTXYLOC, ACLOC, OUTPAR) USE DATAPOOL IMPLICIT NONE INTEGER, INTENT(IN) :: ISMAX INTEGER, intent(in) :: IELOC REAL(rkind), intent(in) :: WI(3) REAL(rkind), INTENT(IN) :: ACLOC(MSC,MDC), WKLOC(MSC), DEPLOC, CURTXYLOC(2) REAL(rkind), INTENT(OUT) :: OUTPAR(OUTVARS_COMPLETE) integer :: IP, J REAL(rkind) :: HS,TM01,TM02,KLM,WLM,TM10 REAL(rkind) :: TPP,FPP,CPP,WNPP,CGPP,KPP,LPP,PEAKDSPR,PEAKD,DPEAK,TPPD,KPPD,CGPD,CPPD REAL(rkind) :: UBOT,ORBITAL,BOTEXPER,TMBOT,URSELL,ETOTS,ETOTC,DM,DSPR REAL(rkind) :: STOKESSURFX,STOKESSURFY REAL(rkind) :: STOKESBAROX,STOKESBAROY REAL(rkind) :: STOKESBOTTX,STOKESBOTTY REAL(rkind) :: eWindMag OUTPAR = ZERO IF (VAROUT_STATION%ComputeMean) THEN CALL MEAN_PARAMETER_LOC(ACLOC,CURTXYLOC,DEPLOC,WKLOC,ISMAX,HS,TM01,TM02,TM10,KLM,WLM) OUTPAR(1) = HS ! Significant wave height OUTPAR(2) = TM01 ! Mean average period OUTPAR(3) = TM02 ! Zero down crossing period for comparison with buoy. OUTPAR(4) = TM10 ! Mean period of wave overtopping/run-up OUTPAR(5) = KLM ! Mean wave number OUTPAR(6) = WLM ! Mean wave length END IF IF (VAROUT_STATION%ComputeDirSpread) THEN CALL MEAN_DIRECTION_AND_SPREAD_LOC(ACLOC,ISMAX,ETOTS,ETOTC,DM,DSPR) OUTPAR(7) = ETOTC ! Etot energy in horizontal direction OUTPAR(8) = ETOTS ! Etot energy in vertical direction OUTPAR(9) = DM ! Mean average energy transport direction OUTPAR(10) = DSPR ! Mean directional spreading END IF IF (VAROUT_STATION%ComputePeak) THEN CALL PEAK_PARAMETER_LOC(ACLOC,DEPLOC,ISMAX,FPP,TPP,CPP,WNPP,CGPP,KPP,LPP,PEAKDSPR,PEAKD,DPEAK,TPPD,KPPD,CGPD,CPPD) OUTPAR(11) = TPPD ! Discrete Peak Period OUTPAR(12) = CPPD ! Discrete Peak speed OUTPAR(13) = KPPD ! Discrete Peak wave number OUTPAR(14) = CGPD ! Discrete Peak group speed OUTPAR(15) = TPP ! Continues Peak period OUTPAR(16) = CPP ! Peak phase vel. OUTPAR(17) = WNPP ! Peak n-factor OUTPAR(18) = CGPP ! Peak group vel. OUTPAR(19) = KPP ! Peak wave number OUTPAR(20) = LPP ! Peak wave length. OUTPAR(21) = PEAKD ! Peak direction OUTPAR(22) = PEAKDSPR ! Peak directional spreading OUTPAR(23) = DPEAK ! Discrete peak direction END IF IF (VAROUT_STATION%ComputeCurr) THEN CALL WAVE_CURRENT_PARAMETER_LOC(ACLOC,CURTXYLOC,DEPLOC,WKLOC,UBOT,ORBITAL,BOTEXPER,TMBOT) OUTPAR(24) = UBOT ! OUTPAR(25) = ORBITAL ! Orbital vel. OUTPAR(26) = BOTEXPER ! Bottom excursion period. OUTPAR(27) = TMBOT ! END IF IF (VAROUT_STATION%ComputeUrsell) THEN CALL URSELL_NUMBER(HS,MyREAL(1)/TPP,DEPLOC,URSELL) OUTPAR(28) = URSELL ! Uresell number based on peak period ... END IF DO J=1,3 IP=INE(J, IELOC) OUTPAR(29) = OUTPAR(29) + WI(J)*UFRIC(IP) OUTPAR(30) = OUTPAR(30) + WI(J)*Z0(IP) OUTPAR(31) = OUTPAR(31) + WI(J)*ALPHA_CH(IP) OUTPAR(32) = OUTPAR(22) + WI(J)*WINDXY(IP,1) OUTPAR(33) = OUTPAR(33) + WI(J)*WINDXY(IP,2) OUTPAR(34) = OUTPAR(34) + WI(J)*CD(IP) OUTPAR(35) = OUTPAR(35) + WI(J)*CURTXY(IP,1) OUTPAR(36) = OUTPAR(36) + WI(J)*CURTXY(IP,2) OUTPAR(37) = OUTPAR(37) + WI(J)*WATLEV(IP) OUTPAR(38) = OUTPAR(38) + WI(J)*WATLEVOLD(IP) OUTPAR(39) = OUTPAR(39) + WI(J)*DEPDT(IP) OUTPAR(40) = OUTPAR(40) + WI(J)*DEP(IP) eWindMag=SQRT(WINDXY(IP,1)**2.+WINDXY(IP,2)**2.) OUTPAR(41) = OUTPAR(41) + WI(J)*eWindMag OUTPAR(42) = OUTPAR(42) + WI(J)*TAUW(IP) OUTPAR(43) = OUTPAR(43) + WI(J)*TAUW(IP) OUTPAR(44) = OUTPAR(44) + WI(J)*TAUW(IP) OUTPAR(45) = OUTPAR(45) + WI(J)*TAUHF(IP) OUTPAR(46) = OUTPAR(46) + WI(J)*TAUTOT(IP) OUTPAR(53) = OUTPAR(53) + WI(J)*RSXX(IP) OUTPAR(54) = OUTPAR(54) + WI(J)*RSXY(IP) OUTPAR(55) = OUTPAR(55) + WI(J)*RSYY(IP) IF (LCFL) THEN OUTPAR(56) = OUTPAR(56) + WI(J)*CFLCXY(1,IP) OUTPAR(57) = OUTPAR(57) + WI(J)*CFLCXY(2,IP) OUTPAR(58) = OUTPAR(58) + WI(J)*CFLCXY(3,IP) ENDIF #ifdef WWM_SETUP IF (LZETA_SETUP) THEN OUTPAR(59) = OUTPAR(59) + WI(J)*ZETA_SETUP(IP) END IF #endif END DO IF (VAROUT_STATION%ComputeStokes) THEN CALL STOKES_DRIFT_SURFACE_BAROTROPIC_LOC(ACLOC,DEPLOC,WKLOC,STOKESBOTTX, STOKESBOTTY,STOKESSURFX,STOKESSURFY,STOKESBAROX,STOKESBAROY) OUTPAR(47) = STOKESBOTTX OUTPAR(48) = STOKESBOTTY OUTPAR(49) = STOKESSURFX OUTPAR(50) = STOKESSURFY OUTPAR(51) = STOKESBAROX OUTPAR(52) = STOKESBAROY END IF END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE INTPAR_LOC(I, ISMAX, WKLOC, DEPLOC, CURTXYLOC, ACLOC, OUTPAR) USE DATAPOOL IMPLICIT NONE INTEGER, INTENT(IN) :: ISMAX, I REAL(rkind) , INTENT(IN) :: ACLOC(MSC,MDC), WKLOC(MSC), DEPLOC, CURTXYLOC(2) REAL(rkind) , INTENT(OUT) :: OUTPAR(OUTVARS) REAL(rkind) :: HS,TM01,TM02,KLM,WLM,TM10 REAL(rkind) :: TPP,CPP,WNPP,CGPP,KPP,LPP,PEAKDSPR,PEAKD,DPEAK,TPPD,KPPD,CGPD,CPPD REAL(rkind) :: UBOT,ORBITAL,BOTEXPER,TMBOT,URSELL,ETOTS,ETOTC,DM,DSPR,FPP OUTPAR = 0. IF (ISMAX .GT. MSC) WRITE(DBG%FHNDL,*) 'ERROR IN ISMAX INTPAR_LOC' IF (DEPLOC .LT. DMIN) RETURN CALL MEAN_PARAMETER_LOC(ACLOC,CURTXYLOC,DEPLOC,WKLOC,ISMAX,HS,TM01,TM02,TM10,KLM,WLM) OUTPAR(1) = HS ! Significant wave height OUTPAR(2) = TM01 ! Mean average period OUTPAR(3) = TM02 ! Zero down crossing period for comparison with buoy. OUTPAR(4) = TM10 ! Mean period of wave overtopping/run-up OUTPAR(5) = KLM ! Mean wave number OUTPAR(6) = WLM ! Mean wave length CALL MEAN_DIRECTION_AND_SPREAD_LOC(ACLOC,ISMAX,ETOTS,ETOTC,DM,DSPR) OUTPAR(7) = ETOTC ! Etot energy in horizontal direction OUTPAR(8) = ETOTS ! Etot energy in vertical direction OUTPAR(9) = DM ! Mean average energy transport direction OUTPAR(10) = DSPR ! Mean directional spreading CALL PEAK_PARAMETER_LOC(ACLOC,DEPLOC,ISMAX,FPP,TPP,CPP,WNPP,CGPP,KPP,LPP,PEAKDSPR,PEAKD,DPEAK,TPPD,KPPD,CGPD,CPPD) OUTPAR(11) = TPPD ! Discrete Peak Period OUTPAR(12) = TPP ! Continues Peak period OUTPAR(13) = CPP ! Peak phase vel. OUTPAR(14) = WNPP ! Peak n-factor OUTPAR(15) = CGPP ! Peak group vel. OUTPAR(16) = KPP ! Peak wave number OUTPAR(17) = LPP ! Peak wave length. OUTPAR(18) = PEAKD ! Peak direction OUTPAR(19) = PEAKDSPR ! Peak directional spreading OUTPAR(20) = DPEAK ! Discrete peak direction CALL WAVE_CURRENT_PARAMETER_LOC(ACLOC,CURTXYLOC,DEPLOC,WKLOC,UBOT,ORBITAL,BOTEXPER,TMBOT) OUTPAR(21) = UBOT ! near bottom vel. OUTPAR(22) = ORBITAL ! Orbital vel. OUTPAR(23) = BOTEXPER ! Bottom excursion period. OUTPAR(24) = TMBOT ! near bottom period. IF (TPP .GT. THR) THEN CALL URSELL_NUMBER(HS,MyREAL(1)/TPP,DEPLOC,URSELL) OUTPAR(25) = URSELL ! Uresell number based on peak period ... ENDIF OUTPAR(26:35) = ZERO END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE INTSPEC(MSC, MDC, DDIR, ACLOC, SPSIG, HS) USE DATAPOOL, ONLY : rkind, stat IMPLICIT NONE INTEGER, INTENT(IN) :: MSC, MDC REAL(rkind), INTENT(IN) :: ACLOC(MSC,MDC), SPSIG(MSC), DDIR REAL(rkind), INTENT(OUT) :: HS INTEGER :: ID, IS REAL(rkind) :: ETOT, EAD , DS ETOT = 0. DO ID = 1, MDC DO IS = 2, MSC DS = SPSIG(IS) - SPSIG(IS-1) EAD = 0.5*(SPSIG(IS)*ACLOC(IS,ID)+SPSIG(IS-1)*ACLOC(IS-1,ID))*DS*DDIR ETOT = ETOT + EAD END DO END DO IF (ETOT > 0.0) THEN HS = 4.0*SQRT(ETOT) ELSE HS = 0.0 END IF ! WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH INTSPEC' ! FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE OUTPUT_TEST() USE DATAPOOL IMPLICIT NONE INTEGER :: IP REAL(rkind) :: OUTT(MNP,OUTVARS), ACLOC(MSC,MDC), OUTPAR(OUTVARS) CHARACTER(LEN=15) :: CTIME CALL MJD2CT(MAIN%TMJD, CTIME) OPEN(MISC%FHNDL, FILE = 'output1d.dat' , STATUS = 'UNKNOWN' ) DO IP = 1, MNP IF (DEP(IP) .GT. DMIN) THEN ACLOC(:,:) = AC2(:,:,IP) CALL INTPAR( IP, MSC, ACLOC, OUTPAR ) OUTT(IP,:) = OUTPAR(:) ELSE OUTT(IP,:) = 0. END IF END DO WRITE(MISC%FHNDL,'(A12,6A14)') 'IP','XP','YP','DEPTH','HS','TM01','DSPR' DO IP = 1, MNP IF (YP(IP) .EQ. 198000.00) THEN WRITE (MISC%FHNDL,'(I12,13F14.2)') IP, XP(IP), YP(IP), DEP(IP), OUTT(IP,1), OUTT(IP,3), OUTT(IP,6) END IF END DO CLOSE(MISC%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** #ifdef DARKO SUBROUTINE OUTPUT_HISTORY_SHP( TIME ) ! ! OUTPUT DARKO CSV ! USE DATAPOOL IMPLICIT NONE REAL(rkind), INTENT(IN) :: TIME INTEGER :: IP, IE, IT CHARACTER(LEN=15) :: CTIME REAL(rkind) :: ACLOC(MSC,MDC), OUTPAR(OUTVARS) REAL(rkind) :: OUTT(MNP,OUTVARS) IF (TIME .LT. THR) THEN OPEN( 4001, FILE = 'depth.dat' ) OPEN( 4002, FILE = 'hs.dat' ) END IF CALL MJD2CT(MAIN%TMJD, CTIME) DO IP = 1, MNP ACLOC(:,:) = AC2(:,:,IP) CALL INTPAR( IP, MSC, ACLOC, OUTPAR ) OUTT(IP,:) = OUTPAR(:) END DO IF (TIME .LT. THR) THEN WRITE(OUT%FHNDL,'(4A10)') 'ID', 'X', 'Y', 'Z' DO IE = 1, MNE WRITE(4001,110) IE,',',XP(INE(1,IE)),',',YP(INE(1,IE)),',',DEP(INE(1,IE)) WRITE(4001,110) IE,',',XP(INE(2,IE)),',',YP(INE(2,IE)),',',DEP(INE(2,IE)) WRITE(4001,110) IE,',',XP(INE(3,IE)),',',YP(INE(3,IE)),',',DEP(INE(3,IE)) END DO END IF WRITE(4002,'(4A10)') 'ID', 'X', 'Y', 'HS' DO IE = 1, MNE WRITE(4002,110) IE,',',XP(INE(1,IE)),',',YP(INE(1,IE)),',',OUTT(INE(1,IE),1) WRITE(4002,110) IE,',',XP(INE(2,IE)),',',YP(INE(2,IE)),',',OUTT(INE(2,IE),1) WRITE(4002,110) IE,',',XP(INE(3,IE)),',',YP(INE(3,IE)),',',OUTT(INE(3,IE),1) END DO 110 FORMAT (2X,I10,3(A2,F15.8)) WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH OUTPUT_HISTORY_SHP' FLUSH(STAT%FHNDL) END SUBROUTINE #endif !********************************************************************** !* * !********************************************************************** SUBROUTINE CLSPEC( WKLOC, DEPLOC, CURTXYLOC, ACLOC, ACOUT_1D, ACOUT_2D ) USE DATAPOOL IMPLICIT NONE REAL(rkind), INTENT(IN) :: ACLOC(MSC,MDC), WKLOC(MSC), DEPLOC, CURTXYLOC(2) REAL(rkind), INTENT(OUT) :: ACOUT_1D(MSC,3), ACOUT_2D(MSC,MDC) INTEGER :: IS, ID, ISS REAL(rkind) :: UNITFAC REAL(rkind) :: UDIR, DM REAL(rkind) :: ECLL, EE, RR, EADD, VEC2DEG REAL(rkind) :: SIG1, C1, K1, CG1, SIG2, C2, K2, CG2 REAL(rkind) :: OMEG1, OMEG2, OMEGA, OMEGB, DSIG, DOMEG REAL(rkind) :: RLOW, RUPP, WN1, WN2 REAL(rkind) :: EX, EY, FF, DEG ! IF (LENERGY) THEN UNITFAC = PWIND(2) * G9 ! for true energy ELSE UNITFAC = 1.0 END IF ACOUT_1D = 0. ACOUT_2D = 0. DO ID = 1, MDC UDIR = CURTXYLOC(1) * COSTH(ID) + CURTXYLOC(2) * SINTH(ID) DO IS = 1, MSC ECLL = ACLOC(IS,ID)*SPSIG(IS) IF (.NOT. LSTCU .AND. .NOT. LSECU) THEN ! No current ... relative freq. ACOUT_2D(IS,ID) = ECLL ACOUT_1D(IS,1) = ACOUT_1D(IS,1) + ECLL * DDIR ACOUT_1D(IS,2) = ACOUT_1D(IS,2) + ECLL * DDIR * COSTH(ID) ACOUT_1D(IS,3) = ACOUT_1D(IS,3) + ECLL * DDIR * SINTH(ID) ELSE ! Currents absolute freq. SIG1 = SPSIG(IS) / FRINTH CALL WAVEKCG(DEPLOC, SIG1, WN1, C1, K1, CG1) OMEG1 = SIG1 + K1 * UDIR SIG2 = SPSIG(IS) * FRINTH CALL WAVEKCG(DEPLOC, SIG2, WN2, C2, K2, CG2) OMEG2 = SIG2 + K2 * UDIR DSIG = FRINTF * SPSIG(IS) EE = ECLL * DSIG / ABS(OMEG2-OMEG1) ! Jacobian IF (OMEG1 > OMEG2) THEN ! Swap ... RR = OMEG2 OMEG2 = OMEG1 OMEG1 = RR END IF DO ISS = 1, MSC OMEGA = SPSIG(ISS) / FRINTH OMEGB = SPSIG(ISS) * FRINTH IF (OMEG1 < OMEGB) THEN RLOW = MAX(OMEG1,OMEGA) ELSE CYCLE END IF IF (OMEG2 > OMEGA) THEN RUPP = MIN(OMEG2,OMEGB) ELSE CYCLE END IF IF (RUPP < RLOW) THEN CALL WWM_ABORT('ERROR IN OUTPUTSPC') ELSE ACOUT_2D(ISS,ID) = ACOUT_2D(ISS,ID) + EE * (RUPP-RLOW) EADD = EE * DDIR * (RUPP-RLOW) ACOUT_1D(ISS,1) = ACOUT_1D(ISS,1) + EADD ACOUT_1D(ISS,2) = ACOUT_1D(ISS,2) + EADD * COSTH(ID) ACOUT_1D(ISS,3) = ACOUT_1D(ISS,3) + EADD * SINTH(ID) END IF END DO END IF END DO ! IS END DO ! ID IF (LSTCU .OR. LSECU) THEN !IF (.NOT. LSTCU .OR. .NOT. LSECU) THEN DO ID = 1, MDC DO IS = 1, MSC DOMEG = FRINTF * SPSIG(IS) ACOUT_2D(IS,ID) = ACOUT_2D(IS,ID) / DOMEG END DO END DO DO IS = 1, MSC DOMEG = FRINTF * SPSIG(IS) ACOUT_1D(IS,:) = ACOUT_1D(IS,:) / DOMEG END DO END IF DO IS = 1, MSC IF (ACOUT_1D(IS,1) > TINY(1.0)) THEN EX = ACOUT_1D(IS,2) / ACOUT_1D(IS,1) EY = ACOUT_1D(IS,3) / ACOUT_1D(IS,1) DM = VEC2DEG(EX,EY) CALL DEG2NAUT(DM,DEG,LNAUTIN) ! overwrite x and y energy components by deg and dspr ... ACOUT_1D(IS,2) = DEG FF = MIN(1.0_rkind,SQRT(EX**2.0+EY**2.0)) ACOUT_1D(IS,3) = SQRT(2.0_rkind-2.0_rkind*FF)*180.0_rkind/PI ! to convert ACBIN from m^2/rad/s to m^2/Hz ACOUT_1D(IS,1) = ACOUT_1D(IS,1) * PI2 ELSE ACOUT_1D(IS,1) = -999.0 ACOUT_1D(IS,2) = -999.0 ACOUT_1D(IS,3) = -999.0 END IF END DO ! WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH CLSPEC' ! FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** #ifdef NCDF SUBROUTINE HISTORY_NC_PRINTMMA(eStr, OUTT, NPWORK, NBVAR, I) USE DATAPOOL, only : rkind, MULTIPLEOUT_HIS, MNP, DBG, STAT #ifdef MPI_PARALL_GRID USE DATAPOOL, only : nwild_loc_res, np_global USE DATAPOOL, only : COMM, IERR, NPROC, myrank, rtype, istatus, ierr #endif implicit none character(len=*) :: eStr integer, intent(in) :: I, NPWORK, NBVAR real(rkind), intent(in) :: OUTT(NPWORK, NBVAR) integer istat # ifdef MPI_PARALL_GRID REAL(rkind), allocatable :: LVect(:,:) REAL(rkind) :: eVect(3) integer :: iProc # endif REAL(rkind) :: MinV, MaxV, AvgV # ifdef MPI_PARALL_GRID IF (MULTIPLEOUT_HIS.eq.0) THEN MinV=minval(OUTT(:,I)) MaxV=maxval(OUTT(:,I)) AvgV=sum(OUTT(:,I))/np_global ELSE eVect(1)=minval(OUTT(:,I)) eVect(2)=maxval(OUTT(:,I)) eVect(3)=sum(OUTT(:,I)*nwild_loc_res) IF (myrank.eq.0) THEN allocate(LVect(nproc,3), stat=istat) IF (istat/=0) CALL WWM_ABORT('wwm_output, allocate error 3') LVect(1,:)=eVect DO iProc=2,nproc CALL MPI_RECV(eVect,3,rtype, iProc-1, 190, comm, istatus, ierr) LVect(iProc,:)=eVect END DO MinV=minval(LVect(:,1)) MaxV=maxval(LVect(:,2)) AvgV=sum(LVect(:,3))/np_global deallocate(LVect) ELSE CALL MPI_SEND(eVect,3,rtype, 0, 190, comm, ierr) ENDIF ENDIF IF (myrank.eq.0) THEN WRITE(STAT%FHNDL,110) TRIM(eStr), MinV, MaxV, AvgV END IF # else MinV=minval(OUTT(:,I)) MaxV=maxval(OUTT(:,I)) AvgV=sum(OUTT(:,I))/MNP WRITE(STAT%FHNDL,110) TRIM(eStr), MinV, MaxV, AvgV # endif 110 FORMAT (a8, ' : min=', F11.5, ' max=', F11.5, ' avg=', F11.5) ! WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH HISTORY_NC_PRINTMMA' ! FLUSH(STAT%FHNDL) END SUBROUTINE !********************************************************************** !* * !********************************************************************** SUBROUTINE OUTPUT_HISTORY_NC USE DATAPOOL USE NETCDF IMPLICIT NONE INTEGER :: IP # ifdef MPI_PARALL_GRID REAL(rkind), allocatable :: OUTT_LOC(:,:) REAL(rkind), allocatable :: OUTT(:,:) # else REAL(rkind) :: OUTT(MNP,OUTVARS_COMPLETE) # endif REAL(rkind) :: ACLOC(MSC,MDC), OUTPAR(OUTVARS_COMPLETE) REAL(rkind) :: eTimeDay ! NC defs INTEGER :: LPOS character(len =256) :: FILE_NAME, PRE_FILE_NAME integer :: iret, ncid, ntime_dims, nnode_dims integer :: var_id integer :: I, irec_dim integer POSITION_BEFORE_POINT character (len = *), parameter :: CallFct="OUTPUT_HISTORY_NC" character (len = *), parameter :: UNITS = "units" character (len = *), parameter :: FULLNAME = "full-name" character (len = *), parameter :: COORD = "coordinates" character(len=1), parameter :: ePoint = '.' integer, save :: recs_his integer, save :: recs_his2 integer, save :: ifile = 1 logical, save :: IsInitDone = .FALSE. integer :: np_write, ne_write character(len=40) :: eStr, eStrUnit character(len=80) :: eStrFullName integer, allocatable :: IOBPDoutput(:,:) integer nbTime ! eTimeDay=MAIN%TMJD # ifdef MPI_PARALL_GRID IF (MULTIPLEOUT_HIS.eq.0) THEN np_write=np_global ne_write=ne_global ELSE np_write=NP_RES ne_write=MNE ENDIF # else np_write=MNP ne_write=MNE # endif IF ((np_write.eq.0).or.(ne_write.eq.0)) THEN CALL WWM_ABORT('OUTPUT_HISTORY_NC np_write=0 or ne_write=0') ENDIF LPOS=POSITION_BEFORE_POINT(OUT_HISTORY%FNAME) IF (OUT_HISTORY%IDEF.gt.0) THEN WRITE (PRE_FILE_NAME,10) OUT_HISTORY%FNAME(1:LPOS),ifile 10 FORMAT (a,'_',i4.4) ELSE WRITE (PRE_FILE_NAME,20) OUT_HISTORY%FNAME(1:LPOS) 20 FORMAT (a) ENDIF IF (MULTIPLEOUT_HIS.eq.0) THEN WRITE (FILE_NAME,30) TRIM(PRE_FILE_NAME) 30 FORMAT (a,'.nc') ELSE # ifdef MPI_PARALL_GRID WRITE (FILE_NAME,40) TRIM(PRE_FILE_NAME),myrank 40 FORMAT (a,'_',i4.4,'.nc') # endif ENDIF ! ! Creating the initial history file description ! IF (IsInitDone.eqv..FALSE.) THEN ! At the beginning ... IsInitDone=.TRUE. recs_his2=0 !$OMP MASTER IF (WriteOutputProcess_his) THEN ! create nc file, vars, and do all time independant job iret = nf90_create(TRIM(FILE_NAME), NF90_CLOBBER, ncid) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 1, iret) nbTime=-1 CALL WRITE_NETCDF_HEADERS_1(ncid, -1, MULTIPLEOUT_HIS, GRIDWRITE, IOBPD_HISTORY, np_write, ne_write) iret=nf90_inq_dimid(ncid, 'mnp', nnode_dims) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 2, iret) iret=nf90_inq_dimid(ncid, 'ocean_time', ntime_dims) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 3, iret) DO I=1,OUTVARS_COMPLETE IF (VAROUT_HISTORY%LVAR(I)) THEN CALL NAMEVARIABLE(I, eStr, eStrFullName, eStrUnit) iret=nf90_def_var(ncid,TRIM(eStr),NF90_OUTTYPE_HIS,(/ nnode_dims, ntime_dims /),var_id) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 4, iret) iret=nf90_put_att(ncid,var_id,UNITS,TRIM(eStrUnit)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 5, iret) iret=nf90_put_att(ncid,var_id,FULLNAME,TRIM(eStrFullName)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 6, iret) IF (LSPHE) THEN iret=nf90_put_att(ncid,var_id,COORD,"lon lat") ELSE iret=nf90_put_att(ncid,var_id,COORD,"x y") END IF CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 6, iret) END IF END DO iret=nf90_close(ncid) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 7, iret) ENDIF CALL WRITE_NETCDF_HEADERS_2(FILE_NAME, MULTIPLEOUT_HIS, WriteOutputProcess_his, GRIDWRITE, np_write, ne_write) !$OMP END MASTER END IF ! ! Computing the variables for output. ! # ifdef MPI_PARALL_GRID IF (MULTIPLEOUT_HIS.eq.0) THEN ALLOCATE(OUTT_LOC(NP_GLOBAL,OUTVARS_COMPLETE), OUTT(NP_GLOBAL,OUTVARS_COMPLETE), stat=istat) IF (istat/=0) CALL WWM_ABORT('wwm_output, allocate error 4') OUTT_LOC=0 DO IP = 1, MNP ACLOC(:,:) = AC2(:,:,IP) CALL PAR_COMPLETE(IP, MSC, ACLOC, OUTPAR) OUTT_LOC(iplg(IP),:) = OUTPAR(:) END DO call mpi_reduce(OUTT_LOC,OUTT,NP_GLOBAL*OUTVARS_COMPLETE,rtype, MPI_SUM,0,comm,ierr) IF (myrank.eq.0) THEN DO IP=1,NP_GLOBAL OUTT(IP,:)=OUTT(IP,:)*nwild_gb(IP) enddo END IF DEALLOCATE(OUTT_LOC) ELSE ALLOCATE(OUTT(NP_RES,OUTVARS_COMPLETE), stat=istat) IF (istat/=0) CALL WWM_ABORT('wwm_output, allocate error 5') DO IP = 1, NP_RES ACLOC(:,:) = AC2(:,:,IP) CALL PAR_COMPLETE(IP, MSC, ACLOC, OUTPAR) OUTT(IP,:) = OUTPAR(:) END DO ENDIF # else !$OMP PARALLEL DEFAULT(NONE) SHARED(AC2,OUTT,FRHIGH,MNP,MSC) PRIVATE(ACLOC,OUTPAR,IP) !$OMP DO DO IP = 1, MNP ACLOC(:,:) = AC2(:,:,IP) CALL PAR_COMPLETE(IP, MSC, ACLOC, OUTPAR) OUTT(IP,:) = OUTPAR(:) END DO !$OMP END DO !$OMP END PARALLEL # endif IF (LMONO_OUT) THEN OUTT(:,1) = OUTT(:,1) / SQRT(2.) ENDIF ! ! Writing down the variable in the history file. ! IF (IOBPD_HISTORY) THEN allocate(IOBPDoutput(MDC, np_write), stat=istat) IF (istat/=0) CALL WWM_ABORT('wwm_output, allocate error 6') CALL GET_IOBPD_OUTPUT(IOBPDoutput, np_write) END IF recs_his2=recs_his2 + 1 IF (WriteOutputProcess_his) THEN !$OMP MASTER iret=nf90_open(TRIM(FILE_NAME), nf90_write, ncid) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 10, iret) iret=nf90_inquire(ncid, unlimitedDimId = irec_dim) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 11, iret) iret=nf90_inquire_dimension(ncid, irec_dim,len = recs_his) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 12, iret) recs_his=recs_his+1 IF (recs_his.ne.recs_his2) THEN CALL WWM_ABORT('There are more bugs to be solved'); ENDIF CALL WRITE_NETCDF_TIME(ncid, recs_his, eTimeDay) IF (IOBPD_HISTORY) THEN iret=nf90_inq_varid(ncid, "IOBPD", var_id) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 13, iret) iret=nf90_put_var(ncid,var_id,IOBPDoutput,start = (/1, 1, recs_his/), count = (/ MDC, np_write, 1 /)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 14, iret) END IF DO I=1,OUTVARS_COMPLETE IF (VAROUT_HISTORY%LVAR(I)) THEN CALL NAMEVARIABLE(I, eStr, eStrFullName, eStrUnit) iret=nf90_inq_varid(ncid, TRIM(eStr), var_id) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 15, iret) IF (PRINTMMA) THEN CALL HISTORY_NC_PRINTMMA(eStr, OUTT,np_write,OUTVARS_COMPLETE,I) END IF IF (NF90_RUNTYPE == NF90_OUTTYPE_HIS) THEN iret=nf90_put_var(ncid,var_id,OUTT(:,I),start = (/1, recs_his/), count = (/ np_write, 1 /)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 16, iret) ELSE iret=nf90_put_var(ncid,var_id,SNGL(OUTT(:,I)),start = (/1, recs_his/), count = (/ np_write, 1 /)) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 17, iret) ENDIF END IF END DO iret=nf90_close(ncid) CALL GENERIC_NETCDF_ERROR_WWM(CallFct, 18, iret) !$OMP END MASTER ENDIF IF (IOBPD_HISTORY) THEN deallocate(IOBPDoutput) END IF # ifdef MPI_PARALL_GRID DEALLOCATE(OUTT) # endif IF (OUT_HISTORY%IDEF.gt.0) THEN IF (recs_his2.eq.OUT_HISTORY%IDEF) THEN ifile=ifile+1 IsInitDone = .FALSE. ENDIF ENDIF WRITE(STAT%FHNDL,'("+TRACE...",A,4F15.4)') 'FINISHED WITH OUTPUT_HISTORY_NC' FLUSH(STAT%FHNDL) END SUBROUTINE #endif !********************************************************************** !* * !**********************************************************************