123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150 |
- MODULE florst
- !!======================================================================
- !! *** MODULE florst ***
- !!
- !!
- !! write floats restart files
- !!
- !!======================================================================
- !! History :
- !! 8.0 ! 99-09 (Y. Drillet) : Original code
- !! ! 00-06 (J.-M. Molines) : Profiling floats for CLS
- !! 8.5 ! 02-10 (A. Bozec) F90 : Free form and module
- !! 3.2 ! 10-08 (slaw, cbricaud): netcdf outputs and others
- !!----------------------------------------------------------------------
- #if defined key_floats || defined key_esopa
- !!----------------------------------------------------------------------
- !! 'key_floats' float trajectories
- !!----------------------------------------------------------------------
- !! * Modules used
- USE flo_oce ! ocean drifting floats
- USE dom_oce ! ocean space and time domain
- USE lib_mpp ! distribued memory computing library
- USE in_out_manager ! I/O manager
- IMPLICIT NONE
- PRIVATE
- PUBLIC flo_rst ! routine called by floats.F90
- PUBLIC flo_rst_alloc ! routine called by floats.F90
- INTEGER, ALLOCATABLE, DIMENSION(:) :: iperproc ! 1D workspace
- !! * Substitutions
- # include "domzgr_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/OPA 3.2 , LODYC-IPSL (2009)
- !! $Id: florst.F90 2355 2015-05-20 07:11:50Z ufla $
- !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
- !!----------------------------------------------------------------------
- CONTAINS
- INTEGER FUNCTION flo_rst_alloc()
- !!-------------------------------------------------------------------
- !! *** FUNCTION flo_rst_alloc ***
- !!-------------------------------------------------------------------
- ALLOCATE( iperproc(jpnij), STAT=flo_rst_alloc )
- !
- IF( lk_mpp ) CALL mpp_sum ( flo_rst_alloc )
- IF( flo_rst_alloc /= 0 ) CALL ctl_warn('flo_rst_alloc: failed to allocate arrays.')
- END FUNCTION flo_rst_alloc
- SUBROUTINE flo_rst( kt )
- !!---------------------------------------------------------------------
- !! *** ROUTINE flo_rst ***
- !!
- !! ** Purpose :
- !!
- !!
- !!
- !! ** Method : The frequency of ??? is nwritefl
- !!
- !!----------------------------------------------------------------------
- !! * Arguments
- INTEGER :: kt ! time step
- !! * Local declarations
- CHARACTER (len=80) :: clname ! restart filename
- INTEGER :: ic , jc , jpn ,jfl ! temporary integer
- INTEGER :: inum ! temporary logical unit for restart file
- !!----------------------------------------------------------------------
- IF( ( MOD(kt,nn_stockfl) == 0 ) .OR. ( kt == nitend ) )THEN
- IF(lwp) THEN
- WRITE(numout,*)
- WRITE(numout,*) 'flo_rst : write in restart_float file '
- WRITE(numout,*) '~~~~~~~ '
- ENDIF
- ! file is opened and closed every time it is used.
- clname = 'restart.float.'
- ic = 1
- DO jc = 1, 16
- IF( cexper(jc:jc) /= ' ' ) ic = jc
- END DO
- clname = clname(1:14)//cexper(1:ic)
- ic = 1
- DO jc = 1, 48
- IF( clname(jc:jc) /= ' ' ) ic = jc
- END DO
- inum=0
- IF( lwp )THEN
- CALL ctl_opn( inum, clname, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
- REWIND inum
- ENDIF
- !
- DO jpn = 1, jpnij
- iperproc(jpn) = 0
- END DO
- !
- IF(lwp) THEN
- REWIND(inum)
- WRITE (inum,*) tpifl,tpjfl,tpkfl,nisobfl,ngrpfl
- CLOSE (inum)
- ENDIF
- !
- ! Compute the number of trajectories for each processor
- !
- IF( lk_mpp ) THEN
- DO jfl = 1, jpnfl
- IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND. &
- &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND. &
- &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND. &
- &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN
- iperproc(narea) = iperproc(narea)+1
- ENDIF
- END DO
- CALL mpp_sum( iperproc, jpnij )
- !
- IF(lwp) THEN
- WRITE(numout,*) 'DATE',adatrj
- DO jpn = 1, jpnij
- IF( iperproc(jpn) /= 0 ) THEN
- WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iperproc(jpn), 'trajectories.'
- ENDIF
- END DO
- ENDIF
- ENDIF
- ENDIF
- END SUBROUTINE flo_rst
- # else
- !!----------------------------------------------------------------------
- !! Default option Empty module
- !!----------------------------------------------------------------------
- CONTAINS
- SUBROUTINE flo_rst ! Empty routine
- END SUBROUTINE flo_rst
- #endif
- !!=======================================================================
- END MODULE florst
|