MODULE W3NETCDF
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 95 |
!/ | Last update : 1-June-2018 |
!/ +-----------------------------------+
!/
!/ 01-June-2016 : Origination ( version 6.04 )
!/
! 1. Purpose : NETCDF native output from ww3
!
! 2. Method : To be described
!
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
INTEGER TIME0_NETCDF_QAD(2)
INTEGER TIMEN_NETCDF_QAD(2)
CONTAINS
!/ ------------------------------------------------------------------- /
SUBROUTINE DATE2JD(year, month, day, hour, min, sec, eJD)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : date conversion
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
integer, intent(in) :: year, month, day, hour, min, sec
real(8), intent(out) :: eJD
real(8) :: eJDbase, eFracDay
integer a, y, m
a = floor((DBLE(14) - DBLE(month))/DBLE(12));
y = year + 4800 - a;
m = month + 12*a - 3;
! For a date in the Gregorian calendar:
eJDbase = DBLE(day) &
& + DBLE(floor((DBLE(153)*DBLE(m) + DBLE(2))/DBLE(5))) &
& + DBLE(y)*DBLE(365) &
& + DBLE(floor(DBLE(y)/DBLE(4))) &
& - DBLE(floor(DBLE(y)/DBLE(100))) &
& + DBLE(floor(DBLE(y)/DBLE(400))) - DBLE(32045)
eFracDay=(DBLE(sec) + &
& DBLE(60)*DBLE(min) + &
& DBLE(3600)*(DBLE(hour) - DBLE(12)) &
& )/DBLE(86400)
eJD=eJDbase + eFracDay
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE DATE_ConvertSix2mjd(year, month, day, hour, min, sec, eMJD)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : date conversion
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
integer, intent(in) :: year, month, day, hour, min, sec
real(8), intent(out) :: eMJD
real(8) :: eJD1, eJD2
CALL DATE2JD(year, month, day, hour, min, sec, eJD1)
! CALL DATE2JD(1968, 5, 23, 0, 0, 0, eJD2)
CALL DATE2JD(1858, 11, 17, 0, 0, 0, eJD2)
eMJD=eJD1-eJD2
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE DATE_ConvertString2six(year, month, day, hour, min, sec, eTimeStr)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : date conversion
! 2. Method : linear shape function
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
integer, intent(out) :: year, month, day, hour, min, sec
character(len=15), intent(in) :: eTimeStr
character(len=4) eYear
character(len=2) eMonth, eDay, eHour, eMin, eSec
eYear(1:1) = eTimeStr(1:1)
eYear(2:2) = eTimeStr(2:2)
eYear(3:3) = eTimeStr(3:3)
eYear(4:4) = eTimeStr(4:4)
eMonth(1:1) = eTimeStr(5:5)
eMonth(2:2) = eTimeStr(6:6)
eDay(1:1) = eTimeStr(7:7)
eDay(2:2) = eTimeStr(8:8)
eHour(1:1) = eTimeStr(10:10)
eHour(2:2) = eTimeStr(11:11)
eMin(1:1) = eTimeStr(12:12)
eMin(2:2) = eTimeStr(13:13)
eSec(1:1) = eTimeStr(14:14)
eSec(2:2) = eTimeStr(15:15)
read(eYear , '(i10)' ) year
read(eMonth, '(i10)' ) month
read(eDay , '(i10)' ) day
read(eHour , '(i10)' ) hour
read(eMin , '(i10)' ) min
read(eSec , '(i10)' ) sec
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE DATE_ConvertSix2string(year, month, day, hour, min, sec, eTimeStr)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : date conversion
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
integer, intent(in) :: year, month, day, hour, min, sec
character(len=15), intent(out) :: eTimeStr
WRITE(eTimeStr, 20) year, month, day, hour, min, sec
20 FORMAT (i4.4, i2.2, i2.2, '.', i2.2, i2.2, i2.2)
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE MONTH_LEN(year, month, lenmonth)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : days in month
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
integer, intent(in) :: year, month
integer, intent(out) :: lenmonth
IF ((month .eq. 1).or.(month .eq. 3).or.(month .eq. 5).or.(month .eq. 7)) THEN
lenmonth=31
END IF
IF ((month .eq. 8).or.(month .eq. 10).or.(month .eq. 12)) THEN
lenmonth=31
END IF
IF ((month .eq. 4).or.(month .eq. 6).or.(month .eq. 9).or.(month .eq. 11)) THEN
lenmonth=30
END IF
IF (month .eq. 2) THEN
IF (MOD(year, 4) .ne. 0) THEN
lenmonth=28
ELSE
IF (MOD(year, 100) .ne. 0) THEN
lenmonth=29
ELSE
IF (MOD(year, 400) .ne. 0) THEN
lenmonth=28
ELSE
lenmonth=29
END IF
END IF
END IF
END IF
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE WW3_TO_SIX(TIME, year, month, day, hour, min, sec)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : date conversion
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
INTEGER, intent(in) :: TIME(2)
integer, intent(out) :: year, month, day, hour, min, sec
integer res1, res2
day=MOD(TIME(1), 100)
res1=(TIME(1) - day)/100
month=MOD(res1, 100)
year=(res1 - month)/100
!
sec=MOD(TIME(2), 100)
res2=(TIME(2) - sec)/100
min=MOD(res2, 100)
hour=(res2 - min)/100
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE WW3_TO_JD(TIME, eJD)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : date conversion
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
USE W3ODATMD, only : IAPROC
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
INTEGER, intent(in) :: TIME(2)
real(8), intent(out) :: eJD
real(8) eJD1, eJD2
integer year, month, day, hour, min, sec
CALL WW3_TO_SIX(TIME, year, month, day, hour, min, sec)
CALL DATE2JD(year, month, day, hour, min, sec, eJD1)
CALL DATE2JD(1858, 11, 17, 0, 0, 0, eJD2)
eJD=eJD1-eJD2
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE WW3_TO_string(TIME, eTimeStr)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : date conversion
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
INTEGER, intent(in) :: TIME(2)
character(len=15), intent(out) :: eTimeStr
integer year, month, day, hour, min, sec
CALL WW3_TO_SIX(TIME, year, month, day, hour, min, sec)
CALL DATE_ConvertSix2string(year, month, day, hour, min, sec, eTimeStr)
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE JD2DATE(year, month, day, hour, min, sec, eJD)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : date conversion
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
integer, intent(out) :: year, month, day, hour, min, sec
real(8), intent(in) :: eJD
integer ijd, a, b, c, d, e, m
integer secNear, lenmonth
real(8) :: fjd, second
ijd = floor(eJD + 0.5_8)
!
a = ijd + 32044;
b = floor((DBLE(4)*DBLE(a) + DBLE(3)) / DBLE(146097))
c = a - floor((DBLE(b) * DBLE(146097)) / DBLE(4));
!
d = floor((DBLE(4)*DBLE(c) + DBLE(3)) / DBLE(1461))
e = c - floor((DBLE(1461)*DBLE(d)) / DBLE(4));
m = floor((DBLE(5) * DBLE(e) + DBLE(2)) / DBLE(153))
!
day = e - floor((DBLE(153) * DBLE(m) + DBLE(2)) / DBLE(5)) + 1;
month = m + 3 - 12 * floor(DBLE(m) / DBLE(10))
year = b * 100 + d - 4800 + floor(DBLE(m) / DBLE(10))
!
fjd = eJD - DBLE(ijd) + 0.5_8
second = DBLE(86400) * fjd
hour = floor(second/DBLE(3600))
second = second - DBLE(3600)*DBLE(hour)
min = floor(second/DBLE(60))
sec = floor(second - DBLE(60)*min)
!
! Now renormalizing
!
secNear=NINT(second - DBLE(60)*min)
IF (secNear .eq. 60) THEN
sec=0
min=min+1
END IF
IF (min .eq. 60) THEN
min=0
hour=hour+1
END IF
IF (hour .eq. 24) THEN
hour=0
day=day+1
END IF
CALL MONTH_LEN(year, month, lenmonth)
IF (day .eq. lenmonth+1) THEN
day=1
month=month+1
END IF
IF (month .eq. 13) THEN
month=1
year=year+1
END IF
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE CT2MJD(STIME,XMJD)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : date conversion
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
CHARACTER(LEN=15), INTENT(IN) :: STIME
real(8), INTENT(OUT) :: XMJD
integer year, month, day, hour, min, sec
real(8) XMJD_1858
CALL DATE_ConvertString2six(year, month, day, hour, min, sec, STIME)
CALL DATE_ConvertSix2mjd(year, month, day, hour, min, sec, XMJD)
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE MJD2CT(XMJD,STIME)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : date conversion
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
CHARACTER(LEN=15), INTENT(OUT) :: STIME
real(8), INTENT(IN) :: XMJD
integer year, month, day, hour, min, sec
real(8) XMJD_1858, eMJD
CALL DATE2JD(1858, 11, 17, 0, 0, 0, XMJD_1858)
eMJD = XMJD + XMJD_1858
CALL JD2DATE(year, month, day, hour, min, sec, eMJD)
CALL DATE_ConvertSix2string(year, month, day, hour, min, sec, STIME)
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE IsFullHour(XMJD,result)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : time managment
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
real(8), INTENT(IN) :: XMJD
LOGICAL, INTENT(OUT) :: result
integer year, month, day, hour, min, sec
real(8) XMJD_1858, eMJD
CALL DATE2JD(1858, 11, 17, 0, 0, 0, XMJD_1858)
eMJD = XMJD + XMJD_1858
CALL JD2DATE(year, month, day, hour, min, sec, eMJD)
IF ((sec.eq.0).and.(min.eq.0)) THEN
result=.TRUE.
ELSE
result=.FALSE.
END IF
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE GENERIC_NETCDF_ERROR(CallFct, idx, iret)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : error handling
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
USE NETCDF
implicit none
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
integer, intent(in) :: iret, idx
character(*), intent(in) :: CallFct
character(len=500) :: CHRERR
character(len=1000) :: wwmerr
IF (iret .NE. nf90_noerr) THEN
CHRERR = nf90_strerror(iret)
WRITE(*,*) TRIM(CallFct), ' -', idx, '-', TRIM(CHRERR)
STOP
ENDIF
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE GET_BOUNDARY_STATUS(STATUS)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : boundary status (code duplication)
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
!/PDLIB use yowElementpool, only: ne_global, INE_global
!/PDLIB use yowNodepool, only: np_global
implicit none
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
integer, intent(inout) :: STATUS(np_global)
INTEGER :: COLLECTED(np_global), NEXTVERT(np_global), PREVVERT(np_global)
INTEGER :: ISFINISHED, INEXT, IPREV
INTEGER :: IPNEXT, IPPREV, ZNEXT, IP, I, IE
STATUS(:) = 0
DO IE=1,ne_global
DO I=1,3
IF (I.EQ.1) THEN
IPREV=3
ELSE
IPREV=I-1
END IF
IF (I.EQ.3) THEN
INEXT=1
ELSE
INEXT=I+1
END IF
IP=INE_global(I,IE)
IPNEXT=INE_global(INEXT,IE)
IPPREV=INE_global(IPREV,IE)
IF (STATUS(IP).EQ.0) THEN
STATUS(IP)=1
PREVVERT(IP)=IPPREV
NEXTVERT(IP)=IPNEXT
END IF
END DO
END DO
STATUS(:)=0
DO
COLLECTED(:)=0
DO IE=1,ne_global
DO I=1,3
IF (I.EQ.1) THEN
IPREV=3
ELSE
IPREV=I-1
END IF
IF (I.EQ.3) THEN
INEXT=1
ELSE
INEXT=I+1
END IF
IP=INE_global(I,IE)
IPNEXT=INE_global(INEXT,IE)
IPPREV=INE_global(IPREV,IE)
IF (STATUS(IP).eq.0) THEN
ZNEXT=NEXTVERT(IP)
IF (ZNEXT.eq.IPPREV) THEN
COLLECTED(IP)=1
NEXTVERT(IP)=IPNEXT
IF (NEXTVERT(IP).eq.PREVVERT(IP)) THEN
STATUS(IP)=1
END IF
END IF
END IF
END DO
END DO
ISFINISHED=1
DO IP=1,np_global
IF ((COLLECTED(IP).eq.0).and.(STATUS(IP).eq.0)) THEN
STATUS(IP)=-1
END IF
IF (STATUS(IP).eq.0) THEN
ISFINISHED=0
END IF
END DO
IF (ISFINISHED.eq.1) THEN
EXIT
END IF
END DO
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE NETCDF_QAD_DEFINE_VAR(VarName, nx_dims, ny_dims, ntime_dims, ncid)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : define netcdfvar
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
USE W3GDATMD, ONLY : GTYPE, UNGTYPE
USE NETCDF
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
integer, intent(in) :: nx_dims, ny_dims, ntime_dims, ncid
character(len=*), intent(in) :: VarName
character (len = *), parameter :: CallFct="NETCDF_QAD_DEFINE_VAR"
integer iret, var_id
IF (GTYPE .eq. UNGTYPE) THEN
iret=nf90_def_var(ncid,TRIM(VarName),NF90_REAL,(/ nx_dims, ntime_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 1, iret)
ELSE
iret=nf90_def_var(ncid,TRIM(VarName),NF90_REAL,(/ ny_dims, nx_dims, ntime_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 2, iret)
END IF
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE NETCDF_QAD_PUT_VAR(VarName, fid, nVar, VAR_TOT, ncid, pos)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : put value
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
USE W3GDATMD, ONLY : GTYPE, UNGTYPE
USE W3GDATMD, ONLY : NY, NX, NSEA, MAPFS, MAPSF
USE NETCDF
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
REAL, intent(in) :: VAR_TOT(nVar, NSEA)
integer, intent(in) :: fid, nVar, ncid, pos
character(len=*), intent(in) :: VarName
INTEGER iret, var_id
INTEGER IP_glob, ISEA, IX, IY
character (len = *), parameter :: CallFct="NETCDF_QAD_PUT_VAR"
real varWrite_FE(NX)
real varWrite_FD(NY,NX)
iret=nf90_inq_varid(ncid, TRIM(VarName), var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 1, iret)
IF (GTYPE .eq. UNGTYPE) THEN
varWrite_FE = 0
DO IP_glob=1,NX
ISEA=MAPFS(1,IP_glob)
IF (ISEA .gt. 0) THEN
varWrite_FE(IP_glob)=VAR_TOT(fid, ISEA)
END IF
END DO
iret=nf90_put_var(ncid,var_id,varWrite_FE,start = (/1, pos/), count = (/ NX, 1 /))
CALL GENERIC_NETCDF_ERROR(CallFct, 2, iret)
ELSE
varWrite_FD = 0
DO ISEA=1,NSEA
IX = MAPSF(ISEA,1)
IY = MAPSF(ISEA,2)
varWrite_FD(IY,IX)=VAR_TOT(fid,ISEA)
END DO
iret=nf90_put_var(ncid,var_id,varWrite_FD,start = (/1, 1, pos/), count = (/ NY, NX, 1 /))
CALL GENERIC_NETCDF_ERROR(CallFct, 2, iret)
END IF
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE OUTPUT_NETCDF_QUICK_AND_DIRTY(IMOD, DTG)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : output driver
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
integer, intent(in) :: IMOD
real, intent(in) :: DTG
real(8) eTime, eJD
LOGICAL result
INTEGER, SAVE :: pos_idx = 0
CALL WW3_TO_JD(TIME0_NETCDF_QAD, eJD)
eTime = eJD + DBLE(pos_idx)*DBLE(DTG)/DBLE(86400)
!CALL IsFullHour(eTime,result)
! IF (.true.) THEN
CALL OUTPUT_NETCDF_QUICK_AND_DIRTY_KERNEL(IMOD, DTG, eTime)
! END IF
pos_idx=pos_idx+1
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE OUTPUT_NETCDF_QUICK_AND_DIRTY_KERNEL(IMOD, DTG, eTime)
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | |
!/ | Mathieu Dutour-Sikiric (IRB) |
!/ | Aron Roland (BGS IT&E GmbH) |
!/ | |
!/ | FORTRAN 90 |
!/ | Last update : 01-Mai-2018 |
!/ +-----------------------------------+
!/
!/ 01-Mai-2018 : Origination. ( version 6.04 )
!/
! 1. Purpose : actual output routine
! 2. Method :
! 3. Parameters :
!
! Parameter list
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! Name Type Module Description
! ----------------------------------------------------------------
! STRACE Subr. W3SERVMD Subroutine tracing.
! ----------------------------------------------------------------
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! ----------------------------------------------------------------
!
! 6. Error messages :
! 7. Remarks
! 8. Structure :
! 9. Switches :
!
! !/S Enable subroutine tracing.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/S USE W3SERVMD, ONLY: STRACE
!
USE W3WDATMD, ONLY : WLV
USE W3GDATMD, ONLY : FTE, GTYPE, UNGTYPE, ZB, NSPEC
USE W3ADATMD, ONLY : U10, CX, CY
USE W3ADATMD, ONLY : DW, CG
USE W3WDATMD, ONLY : VA, TIME
USE W3GDATMD, ONLY : MAPSTA, XGRD, YGRD, NX, NY, DDEN, FLAGLL
USE W3GDATMD, ONLY : ECOS, ESIN, SIG, DTH, XFR, IOBP, IOBPD
USE W3GDATMD, ONLY : NK, NTH, NSEA, NSEAL, NTRI, XYB, TRIGP, GRIDS
!/SETUP USE W3WDATMD, ONLY: ZETA_SETUP
!/MPI USE W3ADATMD, ONLY: MPI_COMM_WCMP
USE W3ODATMD, only : IAPROC, NAPROC, NTPROC
!/PDLIB USE yowNodepool, only: ListIPLG, ListNP, ListNPA
!/PDLIB USE yowNodepool, only: np, iplg
!/PDLIB use yowDatapool, only: rtype
!/PDLIB USE yowRankModule, only : IPGL_TO_PROC
USE W3PARALL, only: INIT_GET_ISEA, INIT_GET_JSEA_ISPROC
USE W3GDATMD, only : MAPFS
USE NETCDF
USE constants, only : TPI, TPIINV, RADE
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
!/ ------------------------------------------------------------------- /
!/ Local PARAMETERs
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
!/
!/S CALL STRACE (IENT, 'VA_SETUP_IOBPD')
!
!/MPI INCLUDE "mpif.h"
!/MPI integer :: istatus(MPI_STATUS_SIZE)
integer, intent(in) :: IMOD
real, intent(in) :: DTG
real(8), intent(in) :: eTime
character (len = *), parameter :: CallFct="OUTPUT_NETCDF_QUICK_AND_DIRTY"
character (len = *), parameter :: FILENAME = "WW3_output.nc"
character (len = *), parameter :: UNITS = "units"
integer, parameter :: nVar = 14
REAL VAR_TOT_NSEA(nVar, NSEA), rVect(nVar, NSEA), EBND, ET, HSIG
INTEGER rStatus(NSEA)
INTEGER IK, ISP, ITH, ISEA, I, IPROC, J, JSEA, nbPlus
logical, save :: IsInitDone = .FALSE.
character (len=15) :: eTimeStr
character eChar
integer :: recs_his
INTEGER Status(NSEA)
integer iret, ncid, var_id, irec_dim, ierr, ntime_dims, nnode_dims
integer one_dims, eight_dims, nfreq_dims, ndir_dims, iwbmnpgl_dims
integer three_dims, mne_dims, fifteen_dims, nbIncorr
integer nx_dims, ny_dims
integer, allocatable :: INEtotal(:,:)
integer eIdx(1)
real(8) eJD, eVar(1)
real EBD(NK)
integer oceantimestr_id
real DEPTHwrite(NX)
integer pos, IP_glob
real varWrite(NX)
real FACTOR
real eVal
real eFP, eDSPR, eT02, eDIR, eEBD
real ETX, ETY, eAB, eABX, eABY, EC
real EBAND, eQuotET
integer IKP0, ICEN, ILOW, IHGH
integer ISPROC
real XL, XH, XL2, XH2, DENOM, FP0, EL, EH
real ETHS, eTHM, ThrET
integer IOBP_NX(NX), IOBP_relevant(NX)
integer IWBMNPGL, IX, eIOBP_NX, IWB, istat, idx
integer, allocatable :: ListIdx(:)
real, allocatable :: SPPARM(:,:)
real, allocatable :: WBACbound(:,:,:), WBACexch(:,:,:)
integer nbBound_IOBP, nbBound_ISEA
integer ListIndexes(NX)
integer nbexport, idxbnd, IP, eSend, NPloc
integer sumIOBP_NX, sumIOBP_relevant, eIOBPrel
integer, allocatable :: iVect(:)
integer ListFirst(NAPROC)
logical DOPEAK
integer eMap, eIOBP
integer nbIOBP0, nbIOBP1
integer nbMAP2_IOBP0
REAL, PARAMETER :: THR_FP0 = 0.00000001
DOPEAK = .true.
IF (GRIDS(IMOD)%GTYPE .ne. UNGTYPE) THEN
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'Exiting because the grid is not unstructured'
!/DEBUGNETCDF FLUSH(740+IAPROC)
RETURN
END IF
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'Entering the NETCDF output routine'
!/DEBUGNETCDF FLUSH(740+IAPROC)
!
! There are several arrays in WW3 for handling boundary condition
! One is the MAPSTA array which is defined in ww3_grid (see computation
! of TMPSTA there)
!
! But we have also the IOBP array for that. The IOBP is varying in time.
! IT depends on the wet/dry mechanism.
!
! The boundary conditions are applied in the nest.ww3 file. The boundary is
! set there.
IWBMNPGL = 0
ListIndexes = 0
sumIOBP_NX=0
sumIOBP_relevant=0
nbBound_IOBP=0
nbBound_ISEA=0
nbMAP2_IOBP0=0
nbIOBP0=0
nbIOBP1=0
DO IX=1,NX
ISEA=MAPFS(1,IX)
eMap=MAPSTA(1,IX)
eIOBP=IOBP(IX)
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'IX=', IX, ' IOBP/MAP=', eIOBP, eMap
IF (ISEA .eq. 0) THEN
nbBound_ISEA=nbBound_ISEA+1
END IF
IF (IOBP(IX) .eq. 0) nbIOBP0 = nbIOBP0 + 1
IF (IOBP(IX) .eq. 1) nbIOBP1 = nbIOBP1 + 1
IF (IOBP(IX) .eq. 0) THEN
eIOBP_NX=2
nbBound_IOBP=nbBound_IOBP+1
ELSE
eIOBP_NX=0
END IF
IF ((eMap .eq. 2).and.(eIOBP .eq.0)) THEN
nbMAP2_IOBP0=nbMAP2_IOBP0 + 1
END IF
IF ((eMap .eq. 2).and.(ISEA.ne.0)) THEN
IWBMNPGL = IWBMNPGL + 1
ListIndexes(IX)=IWBMNPGL
eIOBPrel=2
ELSE
eIOBPrel=0
END IF
IOBP_NX(IX)=eIOBP_NX
IOBP_relevant(IX)=eIOBPrel
sumIOBP_NX = sumIOBP_NX + 1 - eIOBP_NX
sumIOBP_relevant = sumIOBP_relevant + 1 - eIOBPrel
END DO
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'nbIOBP0=', nbIOBP0
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'nbIOBP1=', nbIOBP1
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'nbMAP2_IOBP0=', nbMAP2_IOBP0
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'nbBound_ISEA=', nbBound_ISEA
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'nbBound_IOBP=', nbBound_IOBP
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'sumIOBP_NX=', sumIOBP_NX
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'sumIOBP_relevant=', sumIOBP_relevant
!/DEBUGNETCDF FLUSH(740+IAPROC)
allocate(ListIdx(IWBMNPGL), SPPARM(8,IWBMNPGL), stat=istat)
idx=0
DO IX=1,NX
IF (IOBP_relevant(IX) .eq. 2) THEN
idx=idx+1
ListIdx(idx)=IX
END IF
END DO
!
VAR_TOT_NSEA=0
Status=0
DO JSEA=1,NSEAL
CALL INIT_GET_ISEA(ISEA, JSEA)
IP=JSEA
IX=iplg(IP)
ET = 0
ETX = 0
ETY = 0
ET02 = 0
DO IK=1, NK
EBND = 0.
eAB = 0
eABX = 0
eABY = 0
FACTOR = DDEN(IK) / CG(IK,ISEA)
DO ITH=1, NTH
ISP = ITH + (IK-1)*NTH
eEBD = VA(ISP,JSEA) * FACTOR
EBND = EBND + eEBD
eAB = eAB + VA(ISP,JSEA)
eABX = eABX + VA(ISP,JSEA)*ECOS(ITH)
eABY = eABY + VA(ISP,JSEA)*ESIN(ITH)
END DO
EBD(IK) = eAB*FACTOR
ETX = ETX + eABX*FACTOR
ETY = ETY + eABY*FACTOR
ET = ET + EBND
ET02 = ET02 + EBD(IK)*SIG(IK)**2
END DO
EBAND = eAB / CG(NK,ISEA)
ET02 = ET02 + EBAND*0.5*SIG(NK)**4 * DTH
IF ( ET02 .GT. 1.E-7 ) THEN
eT02 = TPI * SQRT(ET / ET02 )
ELSE
eT02 = TPI / SIG(NK)
ENDIF
!
! Computing FP0
!
EC=EBD(NK)
IKP0=0
DO IK=NK-1,2,-1
IF (EC .LT. EBD(IK)) THEN
EC=EBD(IK)
IKP0=IK
END IF
END DO
FP0 = 0
! WRITE(*,*) 'IKP0=', IKP0, ' size(SIG)=', size(SIG)
IF (IKP0 .ne. 0) THEN
FP0 = SIG(IKP0)*TPIINV
END IF
ILOW = MAX ( 1 , IKP0-1 )
ICEN = MAX ( 1 , IKP0 )
IHGH = MIN ( NK , IKP0+1 )
EL = EBD(ILOW) - EBD(ICEN)
EH = EBD(IHGH) - EBD(ICEN)
XL = 1./XFR - 1.
XH = XFR - 1.
XL2 = XL**2
XH2 = XH**2
DENOM = XL*EH - XH*EL
FP0 = FP0*(1. + 0.5*(XL2*EH - XH2*EL) &
/ SIGN(MAX(ABS(DENOM),1.E-15),DENOM))
!
ET = ET + FTE *EBND
ETX = ETX + FTE * eABX/CG(NK,ISEA)
ETY = ETY + FTE * eABY/CG(NK,ISEA)
ThrET=10e-8
IF (ET .gt. ThrET) THEN
! WRITE(*,*) 'ET/ETX/ETY=', ET, ETX, ETY
eQuotET=(ETX**2+ETY**2)/ET**2
ELSE
eQuotET=100
END IF
eTHS = RADE*SQRT(MAX(0., 2. * ( 1. - SQRT ( &
MAX(0.,eQuotET) ) ) ) )
eTHM = ATAN2(ETY,ETX) * 360 / TPI
HSIG = 4. * SQRT ( ET )
VAR_TOT_NSEA(1, ISEA)=HSIG
VAR_TOT_NSEA(2, ISEA)=CX(ISEA)
VAR_TOT_NSEA(3, ISEA)=CY(ISEA)
VAR_TOT_NSEA(4, ISEA)=WLV(ISEA)
VAR_TOT_NSEA(5, ISEA)=ZB(ISEA)
VAR_TOT_NSEA(6, ISEA)=FP0
VAR_TOT_NSEA(7, ISEA)=eT02
VAR_TOT_NSEA(8, ISEA)=eTHS
VAR_TOT_NSEA(9, ISEA)=eTHM
VAR_TOT_NSEA(10, ISEA)=DW(ISEA)
VAR_TOT_NSEA(11, ISEA)=U10(ISEA)
VAR_TOT_NSEA(12, ISEA)=ETX
VAR_TOT_NSEA(13, ISEA)=ETY
!/SETUP VAR_TOT_NSEA(14, ISEA)=ZETA_SETUP(ISEA)
Status(ISEA)=1
END DO
!
! Now find global arrays
!
!/MPI IF (IAPROC .eq. 1) THEN
!/MPI DO iProc=2,NAPROC
!/MPI CALL MPI_RECV(rVect,NSEA*nVar,MPI_REAL, iProc-1, 19, MPI_COMM_WCMP, istatus, ierr)
!/MPI CALL MPI_RECV(rStatus,NSEA,MPI_INTEGER, iProc-1, 23, MPI_COMM_WCMP, istatus, ierr)
!/MPI DO I=1,NSEA
!/MPI IF (rStatus(I) .eq. 1) THEN
!/MPI VAR_TOT_NSEA(:,I)=rVect(:,I)
!/MPI Status(I)=1
!/MPI END IF
!/MPI END DO
!/MPI END DO
!/MPI ELSE
!/MPI CALL MPI_SEND(VAR_TOT_NSEA,NSEA*nVar,MPI_REAL, 0, 19, MPI_COMM_WCMP, ierr)
!/MPI CALL MPI_SEND(Status,NSEA,MPI_INTEGER, 0, 23, MPI_COMM_WCMP, ierr)
!/MPI END IF
allocate(WBACbound(NK, NTH, IWBMNPGL), stat=istat)
nbexport=0
DO IP=1,NP
IP_glob=iplg(IP)
IF (IOBP_relevant(IP_glob) .eq. 2) THEN
ISEA=MAPFS(1,IP_glob)
IF (ISEA .eq. 0) THEN
WRITE(*,*) 'Error in the assignment value ISEA=0'
CALL ABORT
END IF
CALL INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC)
IF (ISPROC .ne. IAPROC) THEN
WRITE(*,*) 'ISPROC != IAPROC, this is a priori an error'
CALL ABORT
END IF
nbexport=nbexport + 1
idxbnd=ListIndexes(IP_glob)
DO IK=1,NK
DO ITH=1,NTH
ISP = ITH + (IK-1)*NTH
eVal=VA(ISP,JSEA)
WBACbound(IK,ITH,idxbnd)=eVal
END DO
END DO
END IF
END DO
!/MPI!/DEBUGNETCDF WRITE(740+IAPROC,*) 'NAPROC=', NAPROC
!/MPI!/DEBUGNETCDF FLUSH(740+IAPROC)
!/MPI IF (GTYPE .eq. UNGTYPE) THEN
!/MPI allocate(iVect(1), stat=istat)
!/MPI ListFirst=0
!/MPI DO IPROC=2,NAPROC
!/MPI ListFirst(IPROC) = ListFirst(IPROC-1) + ListNPA(IPROC-1)
!/MPI END DO
!/MPI IF (IAPROC .eq. 1) THEN
!/MPI DO IPROC=2,NAPROC
!/MPI CALL MPI_RECV(iVect,1,MPI_INT, iProc-1, 19, MPI_COMM_WCMP, istatus, ierr)
!/MPI IF (iVect(1) .gt. 0) THEN
!/MPI allocate(WBACexch(NK,NTH,iVect(1)), stat=istat)
!/MPI!/DEBUGNETCDF WRITE(740+IAPROC,*) 'Before MPI_RECV, tag 21'
!/MPI!/DEBUGNETCDF FLUSH(740+IAPROC)
!/MPI CALL MPI_RECV(WBACexch,NK*NTH*iVect(1),MPI_REAL, iProc-1, 21, MPI_COMM_WCMP, istatus, ierr)
!/MPI!/DEBUGNETCDF WRITE(740+IAPROC,*) 'After MPI_RECV, tag 21'
!/MPI!/DEBUGNETCDF FLUSH(740+IAPROC)
!/MPI NPloc=ListNP(IPROC)
!/MPI idx=0
!/MPI DO IP=1,NPloc
!/MPI IP_glob=ListIPLG(IP + ListFirst(IPROC))
!/MPI IF (IOBP_relevant(IP_glob) .eq. 2) THEN
!/MPI idx=idx + 1
!/MPI idxbnd=ListIndexes(IP_glob)
!/MPI WBACbound(:,:,idxbnd)=WBACexch(:,:,idx)
!/MPI END IF
!/MPI END DO
!/MPI deallocate(WBACexch)
!/MPI END IF
!/MPI END DO
!/MPI ELSE
!/MPI iVect(1)=nbexport
!/MPI CALL MPI_SEND(iVect,1,MPI_INT, 0, 19, MPI_COMM_WCMP, ierr)
!/MPI IF (nbexport .gt. 0) THEN
!/MPI allocate(WBACexch(NK,NTH,nbexport), stat=istat)
!/MPI idx=0
!/MPI DO IP=1,NP
!/MPI IP_glob=iplg(IP)
!/MPI IF (IOBP_relevant(IP_glob) .eq. 2) THEN
!/MPI ISEA=MAPFS(1,IP_glob)
!/MPI CALL INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC)
!/MPI idx=idx+1
!/MPI DO IK=1,NK
!/MPI DO ITH=1,NTH
!/MPI ISP = ITH + (IK-1)*NTH
!/MPI WBACexch(IK,ITH,idx) = VA(ISP,JSEA)
!/MPI END DO
!/MPI END DO
!/MPI END IF
!/MPI END DO
!/MPI!/DEBUGNETCDF WRITE(740+IAPROC,*) 'Before MPI_SEND, tag 21'
!/MPI!/DEBUGNETCDF FLUSH(740+IAPROC)
!/MPI CALL MPI_SEND(WBACexch,NSPEC*nbexport,MPI_REAL, 0, 21, MPI_COMM_WCMP, ierr)
!/MPI!/DEBUGNETCDF WRITE(740+IAPROC,*) 'After MPI_SEND, tag 21'
!/MPI!/DEBUGNETCDF FLUSH(740+IAPROC)
!/MPI deallocate(WBACexch)
!/MPI END IF
!/MPI END IF
!/MPI END IF
IF (IAPROC .eq. 1) THEN
nbIncorr=0
DO I=1,NSEA
IF (Status(I) .eq. 0) THEN
nbIncorr=nbIncorr+1
END IF
END DO
IF (nbIncorr .gt. 0) THEN
WRITE(*,*) ' nbIncorr=', nbIncorr
WRITE(*,*) 'NSEA - NSEAL=', NSEA - NSEAL
STOP
END IF
!
! Initialization des fichiers netcdf
!
IF (IsInitDone.eqv..FALSE.) THEN
IsInitDone=.TRUE.
iret = nf90_create(TRIM(FILENAME), NF90_CLOBBER, ncid)
CALL GENERIC_NETCDF_ERROR(CallFct, 1, iret)
!
! Defining the dimensions
!
iret = nf90_def_dim(ncid, 'ocean_time', NF90_UNLIMITED, ntime_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 2, iret)
!
iret = nf90_def_dim(ncid, 'three', 3, three_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 3, iret)
!
iret = nf90_def_dim(ncid, 'mnp', NX, nnode_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 4, iret)
!
iret = nf90_def_dim(ncid, 'one', 1, one_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 5, iret)
!
iret = nf90_def_dim(ncid, 'fifteen', 15, fifteen_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 6, iret)
iret = nf90_def_dim(ncid, 'eight', 8, eight_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 7, iret)
IF (IWBMNPGL .gt. 0) THEN
iret = nf90_def_dim(ncid, 'IWBMNPGL', IWBMNPGL, iwbmnpgl_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 8, iret)
END IF
iret = nf90_def_dim(ncid, 'nfreq', NK, nfreq_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 9, iret)
iret = nf90_def_dim(ncid, 'ndir', NTH, ndir_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 10, iret)
!
! Defining the time
!
iret=nf90_def_var(ncid,"ocean_time",NF90_DOUBLE,(/ ntime_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 11, iret)
iret=nf90_put_att(ncid,var_id,UNITS,'days since 1858-11-17 00:00:00')
CALL GENERIC_NETCDF_ERROR(CallFct, 12, iret)
iret=nf90_put_att(ncid,var_id,"calendar",'gregorian')
CALL GENERIC_NETCDF_ERROR(CallFct, 13, iret)
iret=nf90_def_var(ncid,'ocean_time_str',NF90_CHAR,(/ fifteen_dims, ntime_dims/), var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 14, iret)
iret=nf90_def_var(ncid,'LSPHE',NF90_INT,(/ one_dims/), var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 15, iret)
!
! Defining the variables
!
IF (GTYPE .eq. UNGTYPE) THEN
iret = nf90_def_dim(ncid, 'mne', NTRI, mne_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 16, iret)
END IF
IF (GTYPE .eq. UNGTYPE) THEN
IF (FLAGLL) THEN
iret=nf90_def_var(ncid,"lon",NF90_REAL,(/ nnode_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 17, iret)
iret=nf90_def_var(ncid,"lat",NF90_REAL,(/ nnode_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 18, iret)
ELSE
iret=nf90_def_var(ncid,"x",NF90_REAL,(/ nnode_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 17, iret)
iret=nf90_def_var(ncid,"y",NF90_REAL,(/ nnode_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 18, iret)
END IF
iret=nf90_def_var(ncid,"IOBP",NF90_INT,(/ nnode_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 19, iret)
iret=nf90_def_var(ncid,"IOBP_WW3",NF90_INT,(/ nnode_dims, ntime_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 20, iret)
iret=nf90_def_var(ncid,"IOBPD",NF90_INT,(/ ndir_dims, nnode_dims, ntime_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 21, iret)
iret=nf90_def_var(ncid,"depth",NF90_REAL,(/ nnode_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 22, iret)
iret=nf90_def_var(ncid,"ele",NF90_INT,(/ three_dims, mne_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 23, iret)
iret=nf90_def_var(ncid,"MAPSTA",NF90_INT,(/ nnode_dims, ntime_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 24, iret)
nx_dims = nnode_dims
ny_dims = -1
ELSE
iret = nf90_def_dim(ncid, 'nx', NX, nx_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 25, iret)
iret = nf90_def_dim(ncid, 'ny', NY, ny_dims)
CALL GENERIC_NETCDF_ERROR(CallFct, 26, iret)
!
IF (FLAGLL) THEN
iret=nf90_def_var(ncid,"lon",NF90_REAL,(/ ny_dims, nx_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 27, iret)
iret=nf90_def_var(ncid,"lat",NF90_REAL,(/ ny_dims, nx_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 28, iret)
ELSE
iret=nf90_def_var(ncid,"x",NF90_REAL,(/ ny_dims, nx_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 27, iret)
iret=nf90_def_var(ncid,"y",NF90_REAL,(/ ny_dims, nx_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 28, iret)
END IF
iret=nf90_def_var(ncid,"MAPSTA",NF90_INT,(/ ny_dims, nx_dims, ntime_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 29, iret)
END IF
CALL NETCDF_QAD_DEFINE_VAR("HS", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("UsurfCurr", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("VsurfCurr", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("WATLEV", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("ZB", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("WINDMAG", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("DW", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("FP", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("TM02", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("DSPR", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("DM", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("ETOTC", nx_dims, ny_dims, ntime_dims, ncid)
CALL NETCDF_QAD_DEFINE_VAR("ETOTS", nx_dims, ny_dims, ntime_dims, ncid)
!/SETUP CALL NETCDF_QAD_DEFINE_VAR("ZETA_SETUP", nx_dims, ny_dims, ntime_dims, ncid)
!
IF ((GTYPE .eq. UNGTYPE).and.(IWBMNPGL.gt.0)) THEN
iret=nf90_def_var(ncid,"SPPARM",NF90_REAL,(/ eight_dims, iwbmnpgl_dims, ntime_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 30, iret)
iret=nf90_def_var(ncid,"WBAC",NF90_REAL,(/ nfreq_dims, ndir_dims, iwbmnpgl_dims, ntime_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 31, iret)
END IF
iret=nf90_def_var(ncid,"ocean_idx",NF90_INT,(/ ntime_dims /),var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 32, iret)
iret=nf90_close(ncid)
CALL GENERIC_NETCDF_ERROR(CallFct, 33, iret)
!
! Constant writes
!
iret=nf90_open(TRIM(FILENAME), nf90_write, ncid)
CALL GENERIC_NETCDF_ERROR(CallFct, 34, iret)
!
IF (FLAGLL) THEN
eIdx(1)=1
ELSE
eIdx(1)=0
END IF
iret=nf90_inq_varid(ncid, "LSPHE", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 35, iret)
iret=nf90_put_var(ncid,var_id,eIdx,start = (/1/), count = (/1/))
CALL GENERIC_NETCDF_ERROR(CallFct, 36, iret)
!
IF (GTYPE .eq. UNGTYPE) THEN
IF (FLAGLL) THEN
iret=nf90_inq_varid(ncid, "lon", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 37, iret)
iret=nf90_put_var(ncid,var_id,XYB(:,1),start = (/1/), count = (/NX/))
CALL GENERIC_NETCDF_ERROR(CallFct, 38, iret)
!
iret=nf90_inq_varid(ncid, "lat", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 39, iret)
iret=nf90_put_var(ncid,var_id,XYB(:,2),start = (/1/), count = (/NX/))
CALL GENERIC_NETCDF_ERROR(CallFct, 40, iret)
ELSE
iret=nf90_inq_varid(ncid, "x", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 37, iret)
iret=nf90_put_var(ncid,var_id,XYB(:,1),start = (/1/), count = (/NX/))
CALL GENERIC_NETCDF_ERROR(CallFct, 38, iret)
!
iret=nf90_inq_varid(ncid, "y", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 39, iret)
iret=nf90_put_var(ncid,var_id,XYB(:,2),start = (/1/), count = (/NX/))
CALL GENERIC_NETCDF_ERROR(CallFct, 40, iret)
END IF
!
iret=nf90_inq_varid(ncid, "IOBP", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 41, iret)
iret=nf90_put_var(ncid,var_id,IOBP_relevant,start = (/1/), count = (/NX/))
CALL GENERIC_NETCDF_ERROR(CallFct, 42, iret)
!
iret=nf90_inq_varid(ncid, "depth", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 43, iret)
DEPTHwrite=-XYB(:,3)
iret=nf90_put_var(ncid,var_id,DEPTHwrite,start = (/1/), count = (/NX/))
CALL GENERIC_NETCDF_ERROR(CallFct, 44, iret)
!
ALLOCATE(INEtotal(3, NTRI))
DO J=1,3
INEtotal(J,:)=TRIGP(:,J)
END DO
iret=nf90_inq_varid(ncid, "ele", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 53, iret)
iret=nf90_put_var(ncid,var_id,INEtotal,start = (/1, 1/), count = (/3, NTRI/))
CALL GENERIC_NETCDF_ERROR(CallFct, 54, iret)
DEALLOCATE(INEtotal)
ELSE
IF (FLAGLL) THEN
iret=nf90_inq_varid(ncid, "lon", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 47, iret)
iret=nf90_put_var(ncid,var_id,XGRD,start = (/1, 1/), count = (/NY, NX/))
CALL GENERIC_NETCDF_ERROR(CallFct, 48, iret)
!
iret=nf90_inq_varid(ncid, "lat", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 49, iret)
iret=nf90_put_var(ncid,var_id,YGRD,start = (/1, 1/), count = (/NY, NX/))
CALL GENERIC_NETCDF_ERROR(CallFct, 50, iret)
ELSE
iret=nf90_inq_varid(ncid, "x", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 47, iret)
iret=nf90_put_var(ncid,var_id,XGRD,start = (/1, 1/), count = (/NY, NX/))
CALL GENERIC_NETCDF_ERROR(CallFct, 48, iret)
!
iret=nf90_inq_varid(ncid, "y", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 49, iret)
iret=nf90_put_var(ncid,var_id,YGRD,start = (/1, 1/), count = (/NY, NX/))
CALL GENERIC_NETCDF_ERROR(CallFct, 50, iret)
END IF
END IF
!
iret=nf90_close(ncid)
CALL GENERIC_NETCDF_ERROR(CallFct, 55, iret)
END IF
!
! Now writing the results
!
iret=nf90_open(TRIM(FILENAME), nf90_write, ncid)
CALL GENERIC_NETCDF_ERROR(CallFct, 56, iret)
iret=nf90_inquire(ncid, unlimitedDimId = irec_dim)
CALL GENERIC_NETCDF_ERROR(CallFct, 57, iret)
iret=nf90_inquire_dimension(ncid, irec_dim,len = recs_his)
CALL GENERIC_NETCDF_ERROR(CallFct, 58, iret)
!
CALL WW3_TO_JD(TIME0_NETCDF_QAD, eJD)
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'OUTPUT_NETCDF_QUICK_AND_DIRTY'
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'QAD: eJD=', eJD
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'QAD: DTG=', DTG
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'QAD: recs_his=', recs_his
!
pos=recs_his+1
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'pos=', pos
!/DEBUGNETCDF FLUSH(740+IAPROC)
eVar(1)=eTime
iret=nf90_inq_varid(ncid, "ocean_time", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 59, iret)
iret=nf90_put_var(ncid,var_id,eVar,start = (/pos/), count = (/ 1 /))
CALL GENERIC_NETCDF_ERROR(CallFct, 60, iret)
!
CALL MJD2CT(eTime, eTimeStr)
iret=nf90_inq_varid(ncid, 'ocean_time_str', var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 61, iret)
DO i=1,15
eChar=eTimeStr(i:i)
iret=nf90_put_var(ncid,var_id,eChar,start=(/i, pos/) )
CALL GENERIC_NETCDF_ERROR(CallFct, 62, iret)
END DO
!
eIdx(1)=pos
iret=nf90_inq_varid(ncid, "ocean_idx", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 63, iret)
iret=nf90_put_var(ncid,var_id,eIdx,start = (/pos/), count = (/ 1 /))
CALL GENERIC_NETCDF_ERROR(CallFct, 64, iret)
!
! Boundary and company arrays writes:
!
IF (GTYPE .eq. UNGTYPE) THEN
iret=nf90_inq_varid(ncid, "MAPSTA", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 45, iret)
iret=nf90_put_var(ncid,var_id,MAPSTA(1,:),start = (/1, pos/), count = (/NX, 1/))
CALL GENERIC_NETCDF_ERROR(CallFct, 46, iret)
ELSE
iret=nf90_inq_varid(ncid, "MAPSTA", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 51, iret)
iret=nf90_put_var(ncid,var_id,MAPSTA,start = (/1, 1, pos/), count = (/NY, NX, 1/))
CALL GENERIC_NETCDF_ERROR(CallFct, 52, iret)
END IF
IF (GTYPE .eq. UNGTYPE) THEN
iret=nf90_inq_varid(ncid, "IOBP_WW3", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 65, iret)
iret=nf90_put_var(ncid,var_id,IOBP,start = (/1, pos/), count = (/ NX, 1 /))
CALL GENERIC_NETCDF_ERROR(CallFct, 66, iret)
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'sum(IOBP)=', sum(IOBP)
!/DEBUGNETCDF FLUSH(740+IAPROC)
!
iret=nf90_inq_varid(ncid, "IOBPD", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 67, iret)
iret=nf90_put_var(ncid,var_id,IOBPD,start = (/1, 1, pos/), count = (/ NTH, NX, 1 /))
CALL GENERIC_NETCDF_ERROR(CallFct, 68, iret)
END IF
!
CALL NETCDF_QAD_PUT_VAR("HS", 1, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("UsurfCurr", 2, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("VsurfCurr", 3, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("WATLEV", 4, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("ZB", 5, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("FP", 6, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("TM02", 7, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("DSPR", 8, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("DM", 9, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("DW", 10, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("WINDMAG", 11, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("ETOTC", 12, nVar, VAR_TOT_NSEA, ncid, pos)
CALL NETCDF_QAD_PUT_VAR("ETOTS", 13, nVar, VAR_TOT_NSEA, ncid, pos)
!/SETUP CALL NETCDF_QAD_PUT_VAR("ZETA_SETUP", 14, nVar, VAR_TOT_NSEA, ncid, pos)
IF (GTYPE .eq. UNGTYPE) THEN
DO IWB=1,IWBMNPGL
IX=ListIdx(IWB)
ISEA=MAPFS(1,IX)
SPPARM(1,IWB)=VAR_TOT_NSEA(1,ISEA)
SPPARM(3,IWB)=VAR_TOT_NSEA(9,ISEA)
SPPARM(4,IWB)=VAR_TOT_NSEA(8,ISEA)
SPPARM(6,IWB)=1
SPPARM(7,IWB)=0.2
SPPARM(8,IWB)=3.3
IF (DOPEAK) THEN
SPPARM(2,IWB)=1/MAX(THR_FP0, VAR_TOT_NSEA(6,ISEA))
SPPARM(5,IWB)=2
ELSE
SPPARM(2,IWB)=VAR_TOT_NSEA(7,ISEA)
SPPARM(5,IWB)=-2
END IF
END DO
!
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'Before writing of SPPARM'
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'pos=', pos
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'IWBMNPGL=', IWBMNPGL
!/DEBUGNETCDF FLUSH(740+IAPROC)
IF (IWBMNPGL .gt. 0) THEN
iret=nf90_inq_varid(ncid, "SPPARM", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 69, iret)
iret=nf90_put_var(ncid,var_id,SPPARM,start = (/1,1,pos/), count = (/ 8,IWBMNPGL /))
CALL GENERIC_NETCDF_ERROR(CallFct, 70, iret)
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'After writing of SPPARM'
!/DEBUGNETCDF FLUSH(740+IAPROC)
!
iret=nf90_inq_varid(ncid, "WBAC", var_id)
CALL GENERIC_NETCDF_ERROR(CallFct, 71, iret)
iret=nf90_put_var(ncid,var_id,WBACbound,start = (/1,1,1,pos/), count = (/ NK,NTH,IWBMNPGL /))
CALL GENERIC_NETCDF_ERROR(CallFct, 72, iret)
END IF
END IF
!
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'HS values'
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'HS(min/max)=', minval(VAR_TOT_NSEA(1,:)), maxval(VAR_TOT_NSEA(1,:))
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'Ucurr(min/max)=', minval(VAR_TOT_NSEA(2,:)), maxval(VAR_TOT_NSEA(2,:))
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'Vcurr(min/max)=', minval(VAR_TOT_NSEA(3,:)), maxval(VAR_TOT_NSEA(3,:))
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'sum(varWrite)=', sum(varWrite)
!/DEBUGNETCDF FLUSH(740+IAPROC)
!
iret=nf90_close(ncid)
CALL GENERIC_NETCDF_ERROR(CallFct, 73, iret)
END IF
deallocate(ListIdx, SPPARM)
!/DEBUGNETCDF WRITE(740+IAPROC,*) 'Leaving the NETCDF output routine'
!/DEBUGNETCDF FLUSH(740+IAPROC)
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
END MODULE W3NETCDF