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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
dianam.F90 in branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90 @ 8733

Last change on this file since 8733 was 8733, checked in by dancopsey, 6 years ago

Remove svn keywords.

File size: 8.8 KB
Line 
1MODULE dianam
2   !!======================================================================
3   !!                       ***  MODULE  dianam  ***
4   !! Ocean diagnostics:  Builds output file name
5   !!=====================================================================
6   !! History :  OPA  ! 1999-02  (E. Guilyardi)  Creation for 30 days/month
7   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
8   !!            3.2  ! 2009-11  (S. Masson) complete rewriting, works for all calendars...
9   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   dia_nam       : Builds output file name
13   !!----------------------------------------------------------------------
14   USE dom_oce         ! ocean space and time domain
15   USE phycst          ! physical constants
16   USE in_out_manager  ! I/O manager
17   USE ioipsl, ONLY :  ju2ymds    ! for calendar
18
19   IMPLICIT NONE
20   PRIVATE
21
22   PUBLIC dia_nam
23
24   !!----------------------------------------------------------------------
25   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
26   !! $Id$
27   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
28   !!----------------------------------------------------------------------
29
30CONTAINS
31
32   SUBROUTINE dia_nam( cdfnam, kfreq, cdsuff, ldfsec )
33      !!---------------------------------------------------------------------
34      !!                  ***  ROUTINE dia_nam  ***
35      !!                   
36      !! ** Purpose :   Builds output file name
37      !!
38      !! ** Method  :   File name is a function of date and output frequency
39      !!      cdfnam=<cexper>_<clave>_<idtbeg>_<idtend>_<cdsuff>
40      !!      <clave> = averaging frequency (DA, MO, etc...)
41      !!      <idtbeg>,<idtend> date of beginning and end of run
42      !!
43      !!----------------------------------------------------------------------
44      CHARACTER (len=*), INTENT(  out)           ::   cdfnam   ! file name
45      CHARACTER (len=*), INTENT(in   )           ::   cdsuff   ! to be added at the end of the file name
46      INTEGER          , INTENT(in   )           ::   kfreq    ! output frequency: > 0 in time-step (or seconds see ldfsec)
47      !                                                                            < 0 in months
48      !                                                                            = 0 no frequency
49      LOGICAL          , INTENT(in   ), OPTIONAL ::   ldfsec   ! kfreq in second(in time-step) if .true.(.false. default)
50      !
51      CHARACTER (len=20) ::   clfmt, clfmt0                    ! writing format
52      CHARACTER (len=20) ::   clave                            ! name for output frequency
53      CHARACTER (len=20) ::   cldate1                          ! date of the beginning of run
54      CHARACTER (len=20) ::   cldate2                          ! date of the end       of run
55      LOGICAL            ::   llfsec                           ! local value of ldfsec
56      INTEGER            ::   iyear1, imonth1, iday1           ! year, month, day of the first day of the run
57      INTEGER            ::   iyear2, imonth2, iday2           ! year, month, day of the last  day of the run
58      INTEGER            ::   indg                             ! number of digits needed to write a number     
59      INTEGER            ::   inbsec, inbmn, inbhr             ! output frequency in seconds, minutes and hours
60      INTEGER            ::   inbday, inbmo, inbyr             ! output frequency in days, months and years
61      INTEGER            ::   iyyss, iddss, ihhss, immss       ! number of seconds in 1 year, 1 day, 1 hour and 1 minute
62      INTEGER            ::   iyymo                            ! number of months in 1 year
63      REAL(wp)           ::   zsec1, zsec2                     ! not used
64      REAL(wp)           ::   zdrun, zjul                      ! temporary scalars
65      !!----------------------------------------------------------------------
66
67      ! name for output frequency
68
69      IF( PRESENT(ldfsec) ) THEN   ;   llfsec = ldfsec
70      ELSE                         ;   llfsec = .FALSE.
71      ENDIF
72
73      IF( llfsec .OR. kfreq < 0 ) THEN   ;   inbsec = kfreq                       ! output frequency already in seconds
74      ELSE                               ;   inbsec = kfreq * NINT( rdt )   ! from time-step to seconds
75      ENDIF
76      iddss = NINT( rday          )                                         ! number of seconds in 1 day
77      ihhss = NINT( rmmss * rhhmm )                                         ! number of seconds in 1 hour
78      immss = NINT( rmmss         )                                         ! number of seconds in 1 minute
79      iyymo = NINT( raamo         )                                         ! number of months  in 1 year
80      iyyss = iddss * nyear_len(1)                                          ! seconds in 1 year (not good: multi years with leap)
81      clfmt0 = "('(a,i',i1,',a)')"                                          ! format '(a,ix,a)' with x to be defined
82      !
83      IF(          inbsec == 0           ) THEN   ;   clave = ''            ! no frequency
84      ELSEIF(      inbsec <  0           ) THEN       
85         inbmo = -inbsec                                                    ! frequency in month
86         IF( MOD( inbmo, iyymo  ) == 0 ) THEN                               ! frequency in years
87            inbyr  = inbmo / iyymo
88            indg   = INT(LOG10(REAL(inbyr,wp))) + 1                         ! number of digits needed to write years   frequency
89            WRITE(clfmt, clfmt0) indg             ;   WRITE(clave, clfmt) '_', inbyr , 'y'
90         ELSE                                                               ! frequency in month
91            indg   = INT(LOG10(REAL(inbmo,wp))) + 1                         ! number of digits needed to write months  frequency
92            WRITE(clfmt, clfmt0) indg             ;   WRITE(clave, clfmt) '_', inbmo, 'm'
93         ENDIF
94      ELSEIF( MOD( inbsec, iyyss  ) == 0 ) THEN                             ! frequency in years
95         inbyr  = inbsec / iyyss
96         indg   = INT(LOG10(REAL(inbyr ,wp))) + 1                           ! number of digits needed to write years   frequency
97         WRITE(clfmt, clfmt0) indg                ;   WRITE(clave, clfmt) '_', inbyr , 'y'
98      ELSEIF( MOD( inbsec, iddss  ) == 0 ) THEN                             ! frequency in days
99         inbday = inbsec / iddss
100         indg   = INT(LOG10(REAL(inbday,wp))) + 1                           ! number of digits needed to write days    frequency
101         WRITE(clfmt, clfmt0) indg                ;   WRITE(clave, clfmt) '_', inbday, 'd'
102         IF( inbday == nmonth_len(nmonth) )           clave = '_1m'
103      ELSEIF( MOD( inbsec, ihhss ) == 0 ) THEN                              ! frequency in hours
104         inbhr  = inbsec / ihhss
105         indg   = INT(LOG10(REAL(inbhr ,wp))) + 1                           ! number of digits needed to write hours   frequency
106         WRITE(clfmt, clfmt0) indg                ;   WRITE(clave, clfmt) '_', inbhr , 'h'
107      ELSEIF( MOD( inbsec, immss ) == 0 ) THEN                              ! frequency in minutes
108         inbmn  = inbsec / immss
109         indg   = INT(LOG10(REAL(inbmn ,wp))) + 1                           ! number of digits needed to write minutes frequency
110         WRITE(clfmt, clfmt0) indg                ;   WRITE(clave, clfmt) '_', inbmn , 'mn'
111      ELSE                                                                  ! frequency in seconds
112         indg   = INT(LOG10(REAL(inbsec,wp))) + 1                           ! number of digits needed to write seconds frequency
113         WRITE(clfmt, clfmt0) indg                ;   WRITE(clave, clfmt) '_', inbsec, 's'
114      ENDIF
115
116      ! date of the beginning and the end of the run
117
118      zdrun = rdt / rday * REAL( nitend - nit000, wp )                ! length of the run in days
119      zjul  = fjulday - rdt / rday
120      CALL ju2ymds( zjul        , iyear1, imonth1, iday1, zsec1 )           ! year/month/day of the beginning of run
121      CALL ju2ymds( zjul + zdrun, iyear2, imonth2, iday2, zsec2 )           ! year/month/day of the end       of run
122
123      IF( iyear2 < 10000 ) THEN   ;   clfmt = "(i4.4,2i2.2)"                ! format used to write the date
124      ELSE                        ;   WRITE(clfmt, "('(i',i1,',2i2.2)')") INT(LOG10(REAL(iyear2,wp))) + 1
125      ENDIF
126
127      WRITE(cldate1, clfmt) iyear1, imonth1, iday1                          ! date of the beginning of run
128      WRITE(cldate2, clfmt) iyear2, imonth2, iday2                          ! date of the end       of run
129 
130      cdfnam = TRIM(cexper)//TRIM(clave)//"_"//TRIM(cldate1)//"_"//TRIM(cldate2)//"_"//TRIM(cdsuff)
131      IF( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam)
132
133   END SUBROUTINE dia_nam
134
135   !!======================================================================
136END MODULE dianam
Note: See TracBrowser for help on using the repository browser.