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.
icbtrj.F90 in NEMO/trunk/src/OCE/ICB – NEMO

source: NEMO/trunk/src/OCE/ICB/icbtrj.F90 @ 10068

Last change on this file since 10068 was 10068, checked in by nicolasmartin, 6 years ago

First part of modifications to have a common default header : fix typos and SVN keywords properties

  • Property svn:keywords set to Id
File size: 16.8 KB
Line 
1MODULE icbtrj
2   !!======================================================================
3   !!                       ***  MODULE  icbtrj  ***
4   !! Ocean physics:  trajectory I/O routines
5   !!======================================================================
6   !! History :  3.3  !  2010-01  (Martin&Adcroft) Original code
7   !!             -   !  2011-03  (Madec)          Part conversion to NEMO form
8   !!             -   !                            Removal of mapping from another grid
9   !!             -   !  2011-05  (Alderson)       New module to handle trajectory output
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   icb_trj_init  : initialise iceberg trajectory output files
14   !!   icb_trj_write :
15   !!   icb_trj_sync  :
16   !!   icb_trj_end   :
17   !!----------------------------------------------------------------------
18   USE par_oce        ! NEMO parameters
19   USE dom_oce        ! NEMO ocean domain
20   USE phycst         ! NEMO physical constants
21   USE icb_oce        ! define iceberg arrays
22   USE icbutl         ! iceberg utility routines
23   !
24   USE lib_mpp        ! NEMO MPI library, lk_mpp in particular
25   USE in_out_manager ! NEMO IO, numout in particular
26   USE ioipsl  , ONLY : ju2ymds    ! for calendar
27   USE netcdf
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   icb_trj_init    ! routine called in icbini.F90 module
33   PUBLIC   icb_trj_write   ! routine called in icbstp.F90 module
34   PUBLIC   icb_trj_sync    ! routine called in icbstp.F90 module
35   PUBLIC   icb_trj_end     ! routine called in icbstp.F90 module
36
37   INTEGER ::   num_traj
38   INTEGER ::   n_dim, m_dim
39   INTEGER ::   ntrajid
40   INTEGER ::   numberid, nstepid, nscaling_id
41   INTEGER ::   nlonid, nlatid, nxid, nyid, nuvelid, nvvelid, nmassid
42   INTEGER ::   nuoid, nvoid, nuaid, nvaid, nuiid, nviid
43   INTEGER ::   nsshxid, nsshyid, nsstid, ncntid, nthkid
44   INTEGER ::   nthicknessid, nwidthid, nlengthid
45   INTEGER ::   nyearid, ndayid
46   INTEGER ::   nmass_of_bits_id, nheat_density_id
47
48   !!----------------------------------------------------------------------
49   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
50   !! $Id$
51   !! Software governed by the CeCILL license (see ./LICENSE)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE icb_trj_init( ktend )
56      !!----------------------------------------------------------------------
57      !!                  ***  ROUTINE icb_trj_init  ***
58      !!
59      !! ** Purpose :   initialise iceberg trajectory output files
60      !!----------------------------------------------------------------------
61      INTEGER, INTENT(in) ::   ktend   ! time step index
62      !
63      INTEGER                ::   iret, iyear, imonth, iday
64      REAL(wp)               ::   zfjulday, zsec
65      CHARACTER(len=80)      ::   cl_filename
66      CHARACTER(LEN=20)      ::   cldate_ini, cldate_end
67      TYPE(iceberg), POINTER ::   this
68      TYPE(point)  , POINTER ::   pt
69      !!----------------------------------------------------------------------
70
71      ! compute initial time step date
72      CALL ju2ymds( fjulday, iyear, imonth, iday, zsec )
73      WRITE(cldate_ini, '(i4.4,2i2.2)') iyear, imonth, iday
74
75      ! compute end time step date
76      zfjulday = fjulday + rdt / rday * REAL( nitend - nit000 + 1 , wp)
77      IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
78      CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )
79      WRITE(cldate_end, '(i4.4,2i2.2)') iyear, imonth, iday
80
81      ! define trajectory output name
82      IF ( lk_mpp ) THEN   ;   WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A,"_",I4.4,".nc")')   &
83         &                        TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)), narea-1
84      ELSE                 ;   WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A         ,".nc")')   &
85         &                        TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end))
86      ENDIF
87      IF( lwp .AND. nn_verbose_level >= 0 )   WRITE(numout,'(2a)') 'icebergs, icb_trj_init: creating ',TRIM(cl_filename)
88
89      iret = NF90_CREATE( TRIM(cl_filename), NF90_CLOBBER, ntrajid )
90      IF (iret .NE. NF90_NOERR)   CALL ctl_stop('icebergs, icb_trj_init: nf_create failed')
91
92      ! Dimensions
93      iret = NF90_DEF_DIM( ntrajid, 'n', NF90_UNLIMITED, n_dim )
94      IF ( iret /= NF90_NOERR )   CALL ctl_stop('icebergs, icb_trj_init: nf_def_dim n failed')
95      iret = NF90_DEF_DIM( ntrajid, 'k', nkounts, m_dim )
96      IF ( iret /= NF90_NOERR )   CALL ctl_stop('icebergs, icb_trj_init: nf_def_dim k failed')
97
98      ! Variables
99      iret = NF90_DEF_VAR( ntrajid, 'iceberg_number', NF90_INT   , (/m_dim,n_dim/), numberid         )
100      iret = NF90_DEF_VAR( ntrajid, 'timestep'      , NF90_INT   , n_dim          , nstepid          )
101      iret = NF90_DEF_VAR( ntrajid, 'mass_scaling'  , NF90_DOUBLE, n_dim          , nscaling_id      )
102      iret = NF90_DEF_VAR( ntrajid, 'lon'           , NF90_DOUBLE, n_dim          , nlonid           )
103      iret = NF90_DEF_VAR( ntrajid, 'lat'           , NF90_DOUBLE, n_dim          , nlatid           )
104      iret = NF90_DEF_VAR( ntrajid, 'xi'            , NF90_DOUBLE, n_dim          , nxid             )
105      iret = NF90_DEF_VAR( ntrajid, 'yj'            , NF90_DOUBLE, n_dim          , nyid             )
106      iret = NF90_DEF_VAR( ntrajid, 'uvel'          , NF90_DOUBLE, n_dim          , nuvelid          )
107      iret = NF90_DEF_VAR( ntrajid, 'vvel'          , NF90_DOUBLE, n_dim          , nvvelid          )
108      iret = NF90_DEF_VAR( ntrajid, 'uto'           , NF90_DOUBLE, n_dim          , nuoid            )
109      iret = NF90_DEF_VAR( ntrajid, 'vto'           , NF90_DOUBLE, n_dim          , nvoid            )
110      iret = NF90_DEF_VAR( ntrajid, 'uta'           , NF90_DOUBLE, n_dim          , nuaid            )
111      iret = NF90_DEF_VAR( ntrajid, 'vta'           , NF90_DOUBLE, n_dim          , nvaid            )
112      iret = NF90_DEF_VAR( ntrajid, 'uti'           , NF90_DOUBLE, n_dim          , nuiid            )
113      iret = NF90_DEF_VAR( ntrajid, 'vti'           , NF90_DOUBLE, n_dim          , nviid            )
114      iret = NF90_DEF_VAR( ntrajid, 'ssh_x'         , NF90_DOUBLE, n_dim          , nsshxid          )
115      iret = NF90_DEF_VAR( ntrajid, 'ssh_y'         , NF90_DOUBLE, n_dim          , nsshyid          )
116      iret = NF90_DEF_VAR( ntrajid, 'sst'           , NF90_DOUBLE, n_dim          , nsstid           )
117      iret = NF90_DEF_VAR( ntrajid, 'icnt'          , NF90_DOUBLE, n_dim          , ncntid           )
118      iret = NF90_DEF_VAR( ntrajid, 'ithk'          , NF90_DOUBLE, n_dim          , nthkid           )
119      iret = NF90_DEF_VAR( ntrajid, 'mass'          , NF90_DOUBLE, n_dim          , nmassid          )
120      iret = NF90_DEF_VAR( ntrajid, 'thickness'     , NF90_DOUBLE, n_dim          , nthicknessid     )
121      iret = NF90_DEF_VAR( ntrajid, 'width'         , NF90_DOUBLE, n_dim          , nwidthid         )
122      iret = NF90_DEF_VAR( ntrajid, 'length'        , NF90_DOUBLE, n_dim          , nlengthid        )
123      iret = NF90_DEF_VAR( ntrajid, 'year'          , NF90_INT   , n_dim          , nyearid          )
124      iret = NF90_DEF_VAR( ntrajid, 'day'           , NF90_DOUBLE, n_dim          , ndayid           )
125      iret = NF90_DEF_VAR( ntrajid, 'mass_of_bits'  , NF90_DOUBLE, n_dim          , nmass_of_bits_id )
126      iret = NF90_DEF_VAR( ntrajid, 'heat_density'  , NF90_DOUBLE, n_dim          , nheat_density_id )
127
128      ! Attributes
129      iret = NF90_PUT_ATT( ntrajid, numberid        , 'long_name', 'iceberg number on this processor' )
130      iret = NF90_PUT_ATT( ntrajid, numberid        , 'units'    , 'count' )
131      iret = NF90_PUT_ATT( ntrajid, nstepid         , 'long_name', 'timestep number kt' )
132      iret = NF90_PUT_ATT( ntrajid, nstepid         , 'units'    , 'count' )
133      iret = NF90_PUT_ATT( ntrajid, nlonid          , 'long_name', 'longitude' )
134      iret = NF90_PUT_ATT( ntrajid, nlonid          , 'units'    , 'degrees_E')
135      iret = NF90_PUT_ATT( ntrajid, nlatid          , 'long_name', 'latitude' )
136      iret = NF90_PUT_ATT( ntrajid, nlatid          , 'units'    , 'degrees_N' )
137      iret = NF90_PUT_ATT( ntrajid, nxid            , 'long_name', 'x grid box position' )
138      iret = NF90_PUT_ATT( ntrajid, nxid            , 'units'    , 'fractional' )
139      iret = NF90_PUT_ATT( ntrajid, nyid            , 'long_name', 'y grid box position' )
140      iret = NF90_PUT_ATT( ntrajid, nyid            , 'units'    , 'fractional' )
141      iret = NF90_PUT_ATT( ntrajid, nuvelid         , 'long_name', 'zonal velocity' )
142      iret = NF90_PUT_ATT( ntrajid, nuvelid         , 'units'    , 'm/s' )
143      iret = NF90_PUT_ATT( ntrajid, nvvelid         , 'long_name', 'meridional velocity' )
144      iret = NF90_PUT_ATT( ntrajid, nvvelid         , 'units'    , 'm/s' )
145      iret = NF90_PUT_ATT( ntrajid, nuoid           , 'long_name', 'ocean u component' )
146      iret = NF90_PUT_ATT( ntrajid, nuoid           , 'units'    , 'm/s' )
147      iret = NF90_PUT_ATT( ntrajid, nvoid           , 'long_name', 'ocean v component' )
148      iret = NF90_PUT_ATT( ntrajid, nvoid           , 'units'    , 'm/s' )
149      iret = NF90_PUT_ATT( ntrajid, nuaid           , 'long_name', 'atmosphere u component' )
150      iret = NF90_PUT_ATT( ntrajid, nuaid           , 'units'    , 'm/s' )
151      iret = NF90_PUT_ATT( ntrajid, nvaid           , 'long_name', 'atmosphere v component' )
152      iret = NF90_PUT_ATT( ntrajid, nvaid           , 'units'    , 'm/s' )
153      iret = NF90_PUT_ATT( ntrajid, nuiid           , 'long_name', 'sea ice u component' )
154      iret = NF90_PUT_ATT( ntrajid, nuiid           , 'units'    , 'm/s' )
155      iret = NF90_PUT_ATT( ntrajid, nviid           , 'long_name', 'sea ice v component' )
156      iret = NF90_PUT_ATT( ntrajid, nviid           , 'units'    , 'm/s' )
157      iret = NF90_PUT_ATT( ntrajid, nsshxid         , 'long_name', 'sea surface height gradient from x points' )
158      iret = NF90_PUT_ATT( ntrajid, nsshxid         , 'units'    , 'm/m' )
159      iret = NF90_PUT_ATT( ntrajid, nsshyid         , 'long_name', 'sea surface height gradient from y points' )
160      iret = NF90_PUT_ATT( ntrajid, nsshyid         , 'units'    , 'm/m' )
161      iret = NF90_PUT_ATT( ntrajid, nsstid          , 'long_name', 'sea surface temperature' )
162      iret = NF90_PUT_ATT( ntrajid, nsstid          , 'units'    , 'degC')
163      iret = NF90_PUT_ATT( ntrajid, ncntid          , 'long_name', 'sea ice concentration' )
164      iret = NF90_PUT_ATT( ntrajid, ncntid          , 'units'    , 'degC')
165      iret = NF90_PUT_ATT( ntrajid, nthkid          , 'long_name', 'sea ice thickness' )
166      iret = NF90_PUT_ATT( ntrajid, nthkid          , 'units'    , 'm'   )
167      iret = NF90_PUT_ATT( ntrajid, nmassid         , 'long_name', 'mass')
168      iret = NF90_PUT_ATT( ntrajid, nmassid         , 'units'    , 'kg'  )
169      iret = NF90_PUT_ATT( ntrajid, nthicknessid    , 'long_name', 'thickness' )
170      iret = NF90_PUT_ATT( ntrajid, nthicknessid    , 'units'    , 'm'   )
171      iret = NF90_PUT_ATT( ntrajid, nwidthid        , 'long_name', 'width' )
172      iret = NF90_PUT_ATT( ntrajid, nwidthid        , 'units'    , 'm'    )
173      iret = NF90_PUT_ATT( ntrajid, nlengthid       , 'long_name', 'length' )
174      iret = NF90_PUT_ATT( ntrajid, nlengthid       , 'units'    , 'm'    )
175      iret = NF90_PUT_ATT( ntrajid, nyearid         , 'long_name', 'calendar year' )
176      iret = NF90_PUT_ATT( ntrajid, nyearid         , 'units'    , 'years' )
177      iret = NF90_PUT_ATT( ntrajid, ndayid          , 'long_name', 'day of year' )
178      iret = NF90_PUT_ATT( ntrajid, ndayid          , 'units'    , 'days' )
179      iret = NF90_PUT_ATT( ntrajid, nscaling_id     , 'long_name', 'scaling factor for mass of berg' )
180      iret = NF90_PUT_ATT( ntrajid, nscaling_id     , 'units'    , 'none' )
181      iret = NF90_PUT_ATT( ntrajid, nmass_of_bits_id, 'long_name', 'mass of bergy bits' )
182      iret = NF90_PUT_ATT( ntrajid, nmass_of_bits_id, 'units'    , 'kg'   )
183      iret = NF90_PUT_ATT( ntrajid, nheat_density_id, 'long_name', 'heat density' )
184      iret = NF90_PUT_ATT( ntrajid, nheat_density_id, 'units'    , 'J/kg' )
185      !
186      ! End define mode
187      iret = NF90_ENDDEF( ntrajid )
188      !
189   END SUBROUTINE icb_trj_init
190
191
192   SUBROUTINE icb_trj_write( kt )
193      !!----------------------------------------------------------------------
194      !!                  ***  ROUTINE icb_trj_write  ***
195      !!
196      !! ** Purpose :   write out iceberg trajectories
197      !!
198      !! ** Method  : - for the moment write out each snapshot of positions later
199      !!                can rewrite so that it is buffered and written out more efficiently
200      !!----------------------------------------------------------------------
201      INTEGER, INTENT( in ) ::   kt   ! time-step index
202      !
203      INTEGER                ::   iret, jn
204      CHARACTER(len=80)      ::   cl_filename
205      TYPE(iceberg), POINTER ::   this
206      TYPE(point  ), POINTER ::   pt
207      !!----------------------------------------------------------------------
208
209      ! Write variables
210      ! sga - just write out the current point of the trajectory
211
212      this => first_berg
213      jn = num_traj
214      DO WHILE( ASSOCIATED(this) )
215         pt => this%current_point
216         jn = jn + 1
217         !
218         iret = NF90_PUT_VAR( ntrajid, numberid        , this%number      , (/1,jn/) , (/nkounts,1/) )
219         iret = NF90_PUT_VAR( ntrajid, nstepid         , kt               , (/ jn /) )
220         iret = NF90_PUT_VAR( ntrajid, nscaling_id     , this%mass_scaling, (/ jn /) )
221         !
222         iret = NF90_PUT_VAR( ntrajid, nlonid          , pt%lon           , (/ jn /) )
223         iret = NF90_PUT_VAR( ntrajid, nlatid          , pt%lat           , (/ jn /) )
224         iret = NF90_PUT_VAR( ntrajid, nxid            , pt%xi            , (/ jn /) )
225         iret = NF90_PUT_VAR( ntrajid, nyid            , pt%yj            , (/ jn /) )
226         iret = NF90_PUT_VAR( ntrajid, nuvelid         , pt%uvel          , (/ jn /) )
227         iret = NF90_PUT_VAR( ntrajid, nvvelid         , pt%vvel          , (/ jn /) )
228         iret = NF90_PUT_VAR( ntrajid, nuoid           , pt%uo            , (/ jn /) )
229         iret = NF90_PUT_VAR( ntrajid, nvoid           , pt%vo            , (/ jn /) )
230         iret = NF90_PUT_VAR( ntrajid, nuaid           , pt%ua            , (/ jn /) )
231         iret = NF90_PUT_VAR( ntrajid, nvaid           , pt%va            , (/ jn /) )
232         iret = NF90_PUT_VAR( ntrajid, nuiid           , pt%ui            , (/ jn /) )
233         iret = NF90_PUT_VAR( ntrajid, nviid           , pt%vi            , (/ jn /) )
234         iret = NF90_PUT_VAR( ntrajid, nsshxid         , pt%ssh_x         , (/ jn /) )
235         iret = NF90_PUT_VAR( ntrajid, nsshyid         , pt%ssh_y         , (/ jn /) )
236         iret = NF90_PUT_VAR( ntrajid, nsstid          , pt%sst           , (/ jn /) )
237         iret = NF90_PUT_VAR( ntrajid, ncntid          , pt%cn            , (/ jn /) )
238         iret = NF90_PUT_VAR( ntrajid, nthkid          , pt%hi            , (/ jn /) )
239         iret = NF90_PUT_VAR( ntrajid, nmassid         , pt%mass          , (/ jn /) )
240         iret = NF90_PUT_VAR( ntrajid, nthicknessid    , pt%thickness     , (/ jn /) )
241         iret = NF90_PUT_VAR( ntrajid, nwidthid        , pt%width         , (/ jn /) )
242         iret = NF90_PUT_VAR( ntrajid, nlengthid       , pt%length        , (/ jn /) )
243         iret = NF90_PUT_VAR( ntrajid, nyearid         , pt%year          , (/ jn /) )
244         iret = NF90_PUT_VAR( ntrajid, ndayid          , pt%day           , (/ jn /) )
245         iret = NF90_PUT_VAR( ntrajid, nmass_of_bits_id, pt%mass_of_bits  , (/ jn /) )
246         iret = NF90_PUT_VAR( ntrajid, nheat_density_id, pt%heat_density  , (/ jn /) )
247         !
248         this => this%next
249      END DO
250      IF( lwp .AND. nn_verbose_level > 0 )   WRITE(numout,*) 'trajectory write to frame ', jn
251      num_traj = jn
252      !
253   END SUBROUTINE icb_trj_write
254
255
256   SUBROUTINE icb_trj_sync()
257      !!----------------------------------------------------------------------
258      !!                  ***  ROUTINE icb_trj_sync  ***
259      !!
260      !! ** Purpose :   
261      !!----------------------------------------------------------------------
262      INTEGER ::   iret
263      !!----------------------------------------------------------------------
264      ! flush to file
265      iret = NF90_SYNC( ntrajid )
266      IF ( iret /= NF90_NOERR )   CALL ctl_stop( 'icebergs, icb_trj_sync: nf_sync failed' )
267      !
268   END SUBROUTINE icb_trj_sync
269
270
271   SUBROUTINE icb_trj_end()
272      !!----------------------------------------------------------------------
273      INTEGER ::   iret
274      !!----------------------------------------------------------------------
275      ! Finish up
276      iret = NF90_CLOSE( ntrajid )
277      IF ( iret /= NF90_NOERR )   CALL ctl_stop( 'icebergs, icb_trj_end: nf_close failed' )
278      !
279   END SUBROUTINE icb_trj_end
280
281   !!======================================================================
282END MODULE icbtrj
Note: See TracBrowser for help on using the repository browser.