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.
florst.F90 in branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/FLO – NEMO

source: branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90 @ 5948

Last change on this file since 5948 was 5948, checked in by timgraham, 8 years ago

Merged in head of trunk (r5936)

  • Property svn:keywords set to Id
File size: 5.3 KB
Line 
1MODULE florst
2   !!======================================================================
3   !!                       ***  MODULE  florst  ***
4   !! Ocean floats : write floats restart files
5   !!======================================================================
6   !!  History :  OPA  !  1999-09  (Y. Drillet)    : Original code
7   !!              -   !  2000-06  (J.-M. Molines) : Profiling floats for CLS
8   !!   NEMO      1.0  !  2002-10  (A. Bozec)  F90 : Free form and module
9   !!             3.2  !  2010-08  (slaw, cbricaud): netcdf outputs and others
10   !!----------------------------------------------------------------------
11#if   defined key_floats
12   !!----------------------------------------------------------------------
13   !!   'key_floats'                                     float trajectories
14   !!----------------------------------------------------------------------
15   USE flo_oce         ! ocean drifting floats
16   USE dom_oce         ! ocean space and time domain
17   USE lib_mpp         ! distribued memory computing library
18   USE in_out_manager  ! I/O manager
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC flo_rst         ! routine called by floats.F90
24   PUBLIC flo_rst_alloc   ! routine called by floats.F90
25
26   INTEGER, ALLOCATABLE, DIMENSION(:) :: iperproc   ! 1D workspace
27
28   !! * Substitutions
29#  include "domzgr_substitute.h90"
30   !!----------------------------------------------------------------------
31   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
32   !! $Id$
33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
34   !!----------------------------------------------------------------------
35CONTAINS
36
37   INTEGER FUNCTION flo_rst_alloc()
38      !!-------------------------------------------------------------------
39      !!                ***  FUNCTION flo_rst_alloc  ***
40      !!-------------------------------------------------------------------
41      ALLOCATE( iperproc(jpnij), STAT=flo_rst_alloc )
42     
43      IF( lk_mpp             )   CALL mpp_sum ( flo_rst_alloc )
44      IF( flo_rst_alloc /= 0 )   CALL ctl_warn('flo_rst_alloc: failed to allocate arrays.')
45   END FUNCTION flo_rst_alloc
46
47
48   SUBROUTINE flo_rst( kt )
49      !!---------------------------------------------------------------------
50      !!                  ***  ROUTINE flo_rst ***
51      !!             
52      !! ** Purpose : 
53      !!             
54      !!   
55      !!     
56      !! ** Method  :   The frequency of  ??? is nwritefl
57      !!     
58      !!----------------------------------------------------------------------
59      !! * Arguments
60      INTEGER  :: kt                            ! time step
61
62      !! * Local declarations
63      CHARACTER (len=80)       :: clname             ! restart filename
64      INTEGER                  :: ic , jc , jpn ,jfl ! temporary integer
65      INTEGER                  :: inum               ! temporary logical unit for restart file
66      !!----------------------------------------------------------------------
67
68      IF(  ( MOD(kt,nn_stockfl) == 0 ) .OR. ( kt == nitend )  )THEN     
69
70         IF(lwp) THEN
71            WRITE(numout,*)
72            WRITE(numout,*) 'flo_rst : write in  restart_float file '
73            WRITE(numout,*) '~~~~~~~    '
74         ENDIF
75
76         ! file is opened and closed every time it is used.
77
78         clname = 'restart.float.'
79         ic = 1
80         DO jc = 1, 16
81            IF( cexper(jc:jc) /= ' ' ) ic = jc
82         END DO
83         clname = clname(1:14)//cexper(1:ic)
84         ic = 1
85         DO jc = 1, 48
86            IF( clname(jc:jc) /= ' ' ) ic = jc
87         END DO
88
89         inum=0
90         IF( lwp )THEN
91            CALL ctl_opn( inum, clname, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
92            REWIND inum
93         ENDIF
94         !
95         DO jpn = 1, jpnij
96            iperproc(jpn) = 0
97         END DO
98         !
99         IF(lwp) THEN
100            REWIND(inum)
101            WRITE (inum,*) tpifl,tpjfl,tpkfl,nisobfl,ngrpfl
102            CLOSE (inum)
103         ENDIF
104         !
105         ! Compute the number of trajectories for each processor
106         !
107         IF( lk_mpp ) THEN
108            DO jfl = 1, jpnfl
109               IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND.   &
110                  &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND.   &
111                  &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND.   &
112                  &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN
113                  iperproc(narea) = iperproc(narea)+1
114               ENDIF
115            END DO
116            CALL mpp_sum( iperproc, jpnij )
117            !
118            IF(lwp) THEN
119               WRITE(numout,*) 'DATE',adatrj
120               DO jpn = 1, jpnij
121                  IF( iperproc(jpn) /= 0 ) THEN
122                     WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iperproc(jpn), 'trajectories.'
123                  ENDIF
124               END DO
125            ENDIF
126         ENDIF
127
128      ENDIF
129
130   END SUBROUTINE flo_rst
131
132
133#  else
134   !!----------------------------------------------------------------------
135   !!   Default option                                         Empty module
136   !!----------------------------------------------------------------------
137CONTAINS
138   SUBROUTINE flo_rst                 ! Empty routine
139   END SUBROUTINE flo_rst
140#endif
141
142   !!=======================================================================
143END MODULE florst
Note: See TracBrowser for help on using the repository browser.