Changeset 1601 for trunk/NEMO/OPA_SRC/FLO
- Timestamp:
- 2009-08-11T12:09:19+02:00 (15 years ago)
- Location:
- trunk/NEMO/OPA_SRC/FLO
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/FLO/flo_oce.F90
r1152 r1601 2 2 !!====================================================================== 3 3 !! *** MODULE flo_oce *** 4 !! 5 !! ** Purpose : - Define in memory all floats parameters and variables 6 !! 7 !! History : 8 !! 8.0 ! 99-10 (CLIPPER projet) 9 !! 9.0 ! 02-11 (G. Madec, A. Bozec) F90: Free form and module 4 !! lagrangian floats : define in memory all floats parameters and variables 10 5 !!====================================================================== 11 !! OPA 9.0 , LOCEAN-IPSL (2005) 12 !! $Id$ 13 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 6 !! History : OPA ! 1999-10 (CLIPPER projet) 7 !! NEMO 1.0 ! 2002-11 (G. Madec, A. Bozec) F90: Free form and module 14 8 !!---------------------------------------------------------------------- 15 9 #if defined key_floats || defined key_esopa … … 17 11 !! 'key_floats' drifting floats 18 12 !!---------------------------------------------------------------------- 19 !! * Modules used20 13 USE par_oce ! ocean parameters 21 14 22 15 IMPLICIT NONE 16 PUBLIC 23 17 24 18 LOGICAL, PUBLIC, PARAMETER :: lk_floats = .TRUE. !: float flag … … 26 20 !! float parameters 27 21 !! ---------------- 28 INTEGER, PARAMETER :: & 29 jpnfl = 23 , & ! total number of floats during the run 30 jpnnewflo = 0 , & ! number of floats added in a new run 31 jpnrstflo = jpnfl-jpnnewflo ! number of floats for the restart 22 INTEGER, PUBLIC, PARAMETER :: jpnfl = 23 , !: total number of floats during the run 23 INTEGER, PUBLIC, PARAMETER :: jpnnewflo = 0 , !: number of floats added in a new run 24 INTEGER, PUBLIC, PARAMETER :: jpnrstflo = jpnfl - jpnnewflo !: number of floats for the restart 32 25 33 26 !! float variables 34 27 !! --------------- 35 INTEGER, DIMENSION(jpnfl) :: & 36 nisobfl, & ! 0 for a isobar float 37 ! ! 1 for a float following the w velocity 38 ngrpfl ! number to identify searcher group 28 INTEGER, PUBLIC, DIMENSION(jpnfl) :: nisobfl !: =0 for a isobar float , =1 for a float following the w velocity 29 INTEGER, PUBLIC, DIMENSION(jpnfl) :: ngrpfl !: number to identify searcher group 39 30 40 REAL(wp), DIMENSION(jpnfl) :: & 41 flxx, & ! longitude of float (decimal degree) 42 flyy, & ! latitude of float (decimal degree) 43 flzz, & ! depth of float (m, positive) 44 tpifl, & ! index of float position on zonal axe 45 tpjfl, & ! index of float position on meridien axe 46 tpkfl ! index of float position on z axe 31 REAL(wp), PUBLIC, DIMENSION(jpnfl) :: flxx , flyy , flzz !: longitude, latitude, depth of float (decimal degree, m >0) 32 REAL(wp), PUBLIC, DIMENSION(jpnfl) :: tpifl, tpjfl, tpkfl !: (i,j,k) indices of float position 33 34 REAL(wp), PUBLIC, DIMENSION(jpi, jpj, jpk) :: wb !: vertical velocity at previous time step (m s-1). 47 35 48 REAL(wp), DIMENSION(jpi, jpj, jpk) :: & 49 wb ! vertical velocity at previous time step (m s-1). 50 51 ! floats unit 52 53 LOGICAL :: & !!! * namelist namflo * 54 ln_rstflo = .FALSE. , & ! T/F float restart 55 ln_argo = .FALSE. , & ! T/F argo type floats 56 ln_flork4 = .FALSE. ! T/F 4th order Runge-Kutta 57 INTEGER :: & !!! * namelist namflo * 58 nwritefl, & ! frequency of float output file 59 nstockfl ! frequency of float restart file 36 ! !!! * namelist namflo : langrangian floats * 37 LOGICAL, PUBLIC :: ln_rstflo = .FALSE. !: T/F float restart 38 LOGICAL, PUBLIC :: ln_argo = .FALSE. !: T/F argo type floats 39 LOGICAL, PUBLIC :: ln_flork4 = .FALSE. !: T/F 4th order Runge-Kutta 40 INTEGER, PUBLIC :: nn_writefl = 150 !: frequency of float output file 41 INTEGER, PUBLIC :: nn_stockfl = 450 !: frequency of float restart file 60 42 61 43 #else … … 66 48 #endif 67 49 50 !!---------------------------------------------------------------------- 51 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 52 !! $Id$ 53 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 68 54 !!====================================================================== 69 55 END MODULE flo_oce -
trunk/NEMO/OPA_SRC/FLO/floats.F90
r1152 r1601 4 4 !! Ocean floats : floats 5 5 !!====================================================================== 6 !! History : OPA ! (CLIPPER) original Code 7 !! NEMO 1.0 ! 2002-06 (A. Bozec) F90, Free form and module 8 !!---------------------------------------------------------------------- 6 9 #if defined key_floats || defined key_esopa 7 10 !!---------------------------------------------------------------------- … … 11 14 !! flo_init : initialization of float trajectories computation 12 15 !!---------------------------------------------------------------------- 13 !! * Modules used14 16 USE flo_oce ! floats variables 15 17 USE lib_mpp ! distributed memory computing … … 22 24 PRIVATE 23 25 24 !! * Routine accessibility25 PUBLIC flo_stp ! routine called by step.F90 26 PUBLIC flo_stp ! routine called by step.F90 27 26 28 !!---------------------------------------------------------------------- 27 !! OPA 9.0 , LOCEAN-IPSL (2005)29 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 28 30 !! $Id$ 29 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt31 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 30 32 !!---------------------------------------------------------------------- 31 33 … … 42 44 !! algorithm by default and with a 4th order Runge-Kutta scheme 43 45 !! if ln_flork4 =T 44 !!45 !! History :46 !! 8.5 ! 02-06 (A. Bozec, G. Madec ) F90: Free form and module47 46 !!---------------------------------------------------------------------- 48 !! * arguments49 47 INTEGER, INTENT( in ) :: kt ! ocean time step 50 48 !!---------------------------------------------------------------------- 51 49 ! 52 50 IF( kt == nit000 ) THEN 53 51 IF(lwp) WRITE(numout,*) … … 59 57 CALL flo_dom ! compute/read initial position of floats 60 58 61 ! Initialisation of wb for computation of floats trajectories at the first time step 62 wb(:,:,:) = wn(:,:,:) 59 wb(:,:,:) = wn(:,:,:) ! set wb for computation of floats trajectories at the first time step 63 60 ENDIF 64 65 IF( ln_flork4 ) THEN 66 CALL flo_4rk( kt ) ! Trajectories using a 4th order Runge Kutta scheme 67 ELSE 68 CALL flo_blk( kt ) ! Trajectories using Blanke' algorithme 61 ! 62 IF( ln_flork4 ) THEN ; CALL flo_4rk( kt ) ! Trajectories using a 4th order Runge Kutta scheme 63 ELSE ; CALL flo_blk( kt ) ! Trajectories using Blanke' algorithme 69 64 ENDIF 70 65 ! 71 66 IF( lk_mpp ) CALL mppsync ! synchronization of all the processor 72 73 74 ! Writing and restart 75 76 ! trajectories file 77 IF( kt == nit000 .OR. MOD( kt, nwritefl ) == 0 ) CALL flo_wri( kt ) 78 ! restart file 79 IF( kt == nitend .OR. MOD( kt, nstockfl ) == 0 ) CALL flo_wri( kt ) 80 81 ! Save the old vertical velocity field 82 wb(:,:,:) = wn(:,:,:) 83 67 ! 68 IF( kt == nit000 .OR. MOD( kt, nn_writefl ) == 0 ) CALL flo_wri( kt ) ! trajectories file 69 IF( kt == nitend .OR. MOD( kt, nn_stockfl ) == 0 ) CALL flo_wri( kt ) ! restart file 70 ! 71 wb(:,:,:) = wn(:,:,:) ! Save the old vertical velocity field 72 ! 84 73 END SUBROUTINE flo_stp 85 74 … … 90 79 !! 91 80 !! ** Purpose : Read the namelist of floats 92 !!93 !! History :94 !! 8.0 ! (CLIPPER) original Code95 !! 8.5 ! 02-06 (A. Bozec) F90, Free form and module96 81 !!---------------------------------------------------------------------- 97 !! * Modules used98 82 USE ioipsl 99 100 !! * Local declarations 101 NAMELIST/namflo/ ln_rstflo, nwritefl, nstockfl, ln_argo, ln_flork4 83 !! 84 NAMELIST/namflo/ ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4 102 85 !!--------------------------------------------------------------------- 103 ! Namelist namflo : floats 104 105 ! default values 106 ln_rstflo = .FALSE. 107 nwritefl = 150 108 nstockfl = 450 109 110 ! lecture of namflo 111 REWIND( numnam ) 86 ! 87 REWIND( numnam ) ! Namelist namflo : floats 112 88 READ ( numnam, namflo ) 113 114 IF(lwp) THEN 115 WRITE(numout,*) ' '89 ! 90 IF(lwp) THEN ! control print 91 WRITE(numout,*) 116 92 WRITE(numout,*) ' Namelist floats :' 117 93 WRITE(numout,*) ' restart ln_rstflo = ', ln_rstflo 118 WRITE(numout,*) ' frequency of float output file n writefl = ', nwritefl119 WRITE(numout,*) ' frequency of float restart file n stockfl = ', nstockfl94 WRITE(numout,*) ' frequency of float output file nn_writefl = ', nn_writefl 95 WRITE(numout,*) ' frequency of float restart file nn_stockfl = ', nn_stockfl 120 96 WRITE(numout,*) ' Argo type floats ln_argo = ', ln_argo 121 97 WRITE(numout,*) ' Computation of T trajectories ln_flork4 = ', ln_flork4 122 WRITE(numout,*) ' '123 98 ENDIF 124 99 ! 125 100 END SUBROUTINE flo_init 126 101 -
trunk/NEMO/OPA_SRC/FLO/flowri.F90
r1581 r1601 2 2 !!====================================================================== 3 3 !! *** MODULE flowri *** 4 !! 4 !! lagrangian floats : outputs 5 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-11 (G. Madec, A. Bozec) F90: Free form and module 9 !!---------------------------------------------------------------------- 10 6 11 #if defined key_floats || defined key_esopa 7 12 !!---------------------------------------------------------------------- … … 10 15 !! flowri : write trajectories of floats in file 11 16 !!---------------------------------------------------------------------- 12 !! * Modules used13 17 USE flo_oce ! ocean drifting floats 14 18 USE oce ! ocean dynamics and tracers … … 19 23 20 24 IMPLICIT NONE 21 22 !! * Accessibility23 25 PRIVATE 24 PUBLIC flo_wri ! routine called by floats.F90 25 26 !! * Module variables 27 INTEGER :: jfl! number of floats26 27 PUBLIC flo_wri ! routine called by floats.F90 28 29 INTEGER :: jfl ! number of floats 28 30 29 31 !! * Substitutions 30 32 # include "domzgr_substitute.h90" 31 33 !!---------------------------------------------------------------------- 32 !! OPA 9.0 , LOCEAN-IPSL (2005)34 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 33 35 !! $Id$ 34 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt36 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 35 37 !!---------------------------------------------------------------------- 36 38 … … 38 40 39 41 SUBROUTINE flo_wri( kt ) 40 !!------------------------------------------------------------------- --42 !!------------------------------------------------------------------- 41 43 !! *** ROUTINE flo_wri *** 42 44 !! … … 44 46 !! and the temperature and salinity at this position 45 47 !! 46 !! ** Method : The frequency is nwritefl 47 !! 48 !! History : 49 !! 8.0 ! 99-09 (Y. Drillet) Original code 50 !! ! 00-06 (J.-M. Molines) Profiling floats for CLS 51 !! 8.5 ! 02-10 (A. Bozec) F90: Free form and module 48 !! ** Method : The frequency is nn_writefl 52 49 !!---------------------------------------------------------------------- 53 !! * Arguments 54 INTEGER :: kt ! time step 55 56 !! * Local declarations 50 INTEGER :: kt ! time step 51 !! 57 52 CHARACTER (len=21) :: clname 58 INTEGER :: inum ! temporary logical unit for restart file 59 INTEGER :: & 60 iafl,ibfl,icfl,ia1fl,ib1fl,ic1fl,jfl,irecflo, & 61 iafloc,ibfloc,ia1floc,ib1floc, & 62 iafln, ibfln 53 INTEGER :: inum ! temporary logical unit for restart file 54 INTEGER :: iafl, ibfl, icfl, ia1fl, ib1fl, ic1fl, jfl, irecflo, & 55 INTEGER :: iafloc, ibfloc, ia1floc, ib1floc, iafln, ibfln 63 56 INTEGER :: ic, jc , jpn 64 57 INTEGER, DIMENSION ( jpnij ) :: iproc … … 69 62 !!--------------------------------------------------------------------- 70 63 71 IF( kt == nit000 .OR. MOD( kt,n writefl)== 0 ) THEN64 IF( kt == nit000 .OR. MOD( kt,nn_writefl)== 0 ) THEN 72 65 73 66 ! header of output floats file … … 84 77 85 78 IF( kt == nit000 ) THEN 86 irecflo = NINT( (nitend-nit000) / FLOAT(n writefl) )87 IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,n writefl79 irecflo = NINT( (nitend-nit000) / FLOAT(nn_writefl) ) 80 IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nn_writefl 88 81 ENDIF 89 82 zdtj = rdt / 86400. !!bug use of 86400 instead of the phycst parameter … … 246 239 ENDIF 247 240 248 IF( (MOD(kt,n stockfl) == 0) .OR. ( kt == nitend ) ) THEN241 IF( (MOD(kt,nn_stockfl) == 0) .OR. ( kt == nitend ) ) THEN 249 242 ! Writing the restart file 250 243 IF(lwp) THEN
Note: See TracChangeset
for help on using the changeset viewer.