Changeset 3051
- Timestamp:
- 2011-11-07T16:03:29+01:00 (13 years ago)
- Location:
- branches/2011/dev_MERCATOR_2011_MERGE
- Files:
-
- 16 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_MERCATOR_2011_MERGE/DOC/TexFiles/Chapters/Chap_DIA.tex
r3049 r3051 681 681 numeric of the code, so that the trajectories never intercept the bathymetry. 682 682 683 \subsubsection{ Input data: initial coordinates } 684 685 Initial coordinates can be given with Ariane Tools convention ( IJK coordinates ,(\np{ln\_ariane}=true) ) 686 or with longitude and latitude. 687 688 689 In case of Ariane convention, input filename is \np{"init\_float\_ariane"}. Its format is: 690 691 \texttt{ I J K nisobfl itrash itrash } 692 693 \noindent with: 694 695 - I,J,K : indexes of initial position 696 697 - nisobfl: 0 for an isobar float, 1 for a float following the w velocity 698 699 - itrash : set to zero; it is a dummy variable to respect Ariane Tools convention 700 701 - itrash :set to zero; it is a dummy variable to respect Ariane Tools convention 702 703 \noindent Example:\\ 704 \noindent \texttt{ 100.00000 90.00000 -1.50000 1.00000 0.00000}\\ 705 \texttt{ 102.00000 90.00000 -1.50000 1.00000 0.00000}\\ 706 \texttt{ 104.00000 90.00000 -1.50000 1.00000 0.00000}\\ 707 \texttt{ 106.00000 90.00000 -1.50000 1.00000 0.00000}\\ 708 \texttt{ 108.00000 90.00000 -1.50000 1.00000 0.00000}\\ 709 710 711 In the other case ( longitude and latitude ), input filename is \np{"init\_float"}. Its format is: 712 713 \texttt{ Long Lat depth nisobfl ngrpfl itrash} 714 715 \noindent with: 716 717 - Long, Lat, depth : Longitude, latitude, depth 718 719 - nisobfl: 0 for an isobar float, 1 for a float following the w velocity 720 721 - ngrpfl : number to identify searcher group 722 723 - itrash :set to 1; it is a dummy variable. 724 725 \noindent Example: 726 727 \noindent\texttt{ 20.0 0.0 0.0 0 1 1 }\\ 728 \texttt{ -21.0 0.0 0.0 0 1 1 }\\ 729 \texttt{ -22.0 0.0 0.0 0 1 1 }\\ 730 \texttt{ -23.0 0.0 0.0 0 1 1 }\\ 731 \texttt{ -24.0 0.0 0.0 0 1 1 }\\ 732 733 \np{jpnfl} is the total number of floats during the run. 734 When initial positions are read in a restart file ( \np{ln\_rstflo= .TRUE.} ), \np{jpnflnewflo} 735 can be added in the initialization file. 736 737 \subsubsection{ Output data } 738 739 \np{nn\_writefl} is the frequency of writing in float output file and \np{nn\_stockfl} 740 is the frequency of creation of the float restart file. 741 742 Output data can be written in ascii files (\np{ln\_flo\_ascii = .TRUE.} ). In that case, 743 output filename is \np{is trajec\_float}. 744 745 Another possiblity of writing format is Netcdf (\np{ln\_flo\_ascii = .FALSE.} ). There are 2 possibilities: 746 747 - if (\key{iomput}) is used, outputs are selected in \np{iodef.xml}. Here it is an example of specification 748 to put in files description section: 749 750 \vspace{-30pt} 751 \begin{alltt} {{\scriptsize 752 \begin{verbatim} 753 754 <group id="1d\_grid\_T" name="auto" description="ocean T grid variables" > } 755 <file id="floats" description="floats variables"> }\\ 756 <field ref="traj\_lon" name="floats\_longitude" freq\_op="86400" />} 757 <field ref="traj\_lat" name="floats\_latitude" freq\_op="86400" />} 758 <field ref="traj\_dep" name="floats\_depth" freq\_op="86400" />} 759 <field ref="traj\_temp" name="floats\_temperature" freq\_op="86400" />} 760 <field ref="traj\_salt" name="floats\_salinity" freq\_op="86400" />} 761 <field ref="traj\_dens" name="floats\_density" freq\_op="86400" />} 762 <field ref="traj\_group" name="floats\_group" freq\_op="86400" />} 763 </file>} 764 </group>} 765 766 \end{verbatim} 767 }}\end{alltt} 768 769 770 - if (\key{iomput}) is not used, a file called \np{trajec\_float.nc} will be created by IOIPSL library. 771 772 773 683 774 See also \href{http://stockage.univ-brest.fr/~grima/Ariane/}{here} the web site describing 684 775 the off-line use of this marvellous diagnostic tool. -
branches/2011/dev_MERCATOR_2011_MERGE/DOC/TexFiles/Namelist/namflo
r2540 r3051 2 2 &namflo ! float parameters ("key_float") 3 3 !----------------------------------------------------------------------- 4 jpnfl = 1 ! total number of floats during the run 5 jpnnewflo = 0 ! number of floats for the restart 4 6 ln_rstflo = .false. ! float restart (T) or not (F) 5 7 nn_writefl = 75 ! frequency of writing in float output file … … 8 10 ln_flork4 = .false. ! trajectories computed with a 4th order Runge-Kutta (T) 9 11 ! or computed with Blanke' scheme (F) 12 ln_ariane = .true. ! Input with Ariane tool convention(T) 13 ln_ascii = .true. ! Output with Ariane tool netcdf convention(T) or ascii file (F) 10 14 / -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml
r2561 r3051 206 206 </group> 207 207 208 <!-- variables available with key_float --> 209 <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point"> 210 <field id="traj_lon" description="floats longitude" unit="deg" operation="inst(X)" /> 211 <field id="traj_lat" description="floats latitude" unit="deg" /> 212 <field id="traj_dep" description="floats depth" unit="m" /> 213 <field id="traj_temp" description="floats temperature" unit="degC" /> 214 <field id="traj_salt" description="floats salinity" unit="psu" /> 215 <field id="traj_dens" description="floats density" unit="kg/m3" /> 216 <field id="traj_group" description="floats group" unit="none" /> 217 </group> 218 219 208 220 </field_definition> 209 221 … … 286 298 </file> 287 299 300 <!-- variables available with key_float, instantaneous fields --> 301 <file id="floats" description="floats variables"> 302 <field ref="traj_lon" name="floats_longitude" freq_op="432000" /> 303 <field ref="traj_lat" name="floats_latitude" freq_op="432000" /> 304 <field ref="traj_dep" name="floats_depth" freq_op="432000" /> 305 <field ref="traj_temp" name="floats_temperature" freq_op="432000" /> 306 <field ref="traj_salt" name="floats_salinity" freq_op="432000" /> 307 <field ref="traj_dens" name="floats_density" freq_op="432000" /> 308 <field ref="traj_group" name="floats_group" freq_op="432000" /> 309 </file> 310 288 311 </group> 289 312 … … 330 353 <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." /> 331 354 <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." /> 355 <axis id="nfloat" description="Number of float" unit="no unit" positive=".false." /> 332 356 <axis id="none" description="axe non defini" unit="none" size="1" /> 333 357 </axis_definition> -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/CONFIG/GYRE/EXP00/namelist
r3049 r3051 772 772 &namflo ! float parameters ("key_float") 773 773 !----------------------------------------------------------------------- 774 jpnfl = 1 ! total number of floats during the run 775 jpnnewflo = 0 ! number of floats for the restart 774 776 ln_rstflo = .false. ! float restart (T) or not (F) 775 777 nn_writefl = 75 ! frequency of writing in float output file … … 778 780 ln_flork4 = .false. ! trajectories computed with a 4th order Runge-Kutta (T) 779 781 ! or computed with Blanke' scheme (F) 782 ln_ariane = .true. ! Input with Ariane tool convention(T) 783 ln_ascii = .true. ! Output with Ariane tool netcdf convention(F) or ascii file (T) 780 784 / 781 785 !----------------------------------------------------------------------- -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
r3046 r3051 276 276 </group> 277 277 278 279 <!-- variables available with key_float --> 280 <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point"> 281 <field id="traj_lon" description="floats longitude" unit="deg" operation="inst(X)" /> 282 <field id="traj_lat" description="floats latitude" unit="deg" operation="inst(X)" /> 283 <field id="traj_dep" description="floats depth" unit="m" operation="inst(X)" /> 284 <field id="traj_temp" description="floats temperature" unit="degC" operation="inst(X)" /> 285 <field id="traj_salt" description="floats salinity" unit="psu" operation="inst(X)" /> 286 <field id="traj_dens" description="floats density" unit="kg/m3" operation="inst(X)" /> 287 <field id="traj_group" description="floats group" unit="none" operation="inst(X)" /> 288 </group> 289 278 290 </field_definition> 279 291 280 292 <!-- 281 293 ============================================================================================================ … … 336 348 </group> 337 349 338 339 350 <!-- variables available with key_float, instantaneous fields --> 351 <file id="floats" description="floats variables"> 352 <field ref="traj_lon" name="floats_longitude" freq_op="86400" /> 353 <field ref="traj_lat" name="floats_latitude" freq_op="86400" /> 354 <field ref="traj_dep" name="floats_depth" freq_op="86400" /> 355 <field ref="traj_temp" name="floats_temperature" freq_op="86400" /> 356 <field ref="traj_salt" name="floats_salinity" freq_op="86400" /> 357 <field ref="traj_dens" name="floats_density" freq_op="86400" /> 358 <field ref="traj_group" name="floats_group" freq_op="86400" /> 359 </file> 340 360 341 361 </group> … … 459 479 460 480 <axis_definition> 461 <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." /> 462 <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." /> 463 <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." /> 464 <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." /> 481 <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." /> 482 <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." /> 483 <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." /> 484 <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." /> 485 <axis id="nfloat" description="Number of float" unit="no unit" positive=".false." /> 465 486 <axis id="none" description="axe non defini" unit="none" size="1" /> 466 487 </axis_definition> -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
r3049 r3051 772 772 &namflo ! float parameters ("key_float") 773 773 !----------------------------------------------------------------------- 774 jpnfl = 1 ! total number of floats during the run 775 jpnnewflo = 0 ! number of floats for the restart 774 776 ln_rstflo = .false. ! float restart (T) or not (F) 775 777 nn_writefl = 75 ! frequency of writing in float output file … … 778 780 ln_flork4 = .false. ! trajectories computed with a 4th order Runge-Kutta (T) 779 781 ! or computed with Blanke' scheme (F) 782 ln_ariane = .true. ! Input with Ariane tool convention(T) 783 ln_ascii = .true. ! Output with Ariane tool netcdf convention(F) or ascii file (T) 780 784 / 781 785 !----------------------------------------------------------------------- -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
r3049 r3051 764 764 &namflo ! float parameters ("key_float") 765 765 !----------------------------------------------------------------------- 766 jpnfl = 1 ! total number of floats during the run 767 jpnnewflo = 0 ! number of floats for the restart 766 768 ln_rstflo = .false. ! float restart (T) or not (F) 767 769 nn_writefl = 75 ! frequency of writing in float output file … … 771 773 ! or computed with Blanke' scheme (F) 772 774 ! or computed with Blanke' scheme (F) 775 ln_ariane = .true. ! Input with Ariane tool convention(T) 776 ln_ascii = .true. ! Output with Ariane tool netcdf convention(T) or ascii file (F) 773 777 / 774 778 !----------------------------------------------------------------------- -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/CONFIG/POMME/EXP00/namelist
r3049 r3051 777 777 &namflo ! float parameters ("key_float") 778 778 !----------------------------------------------------------------------- 779 jpnfl = 1 ! total number of floats during the run 780 jpnnewflo = 0 ! number of floats for the restart 779 781 ln_rstflo = .false. ! float restart (T) or not (F) 780 782 nn_writefl = 75 ! frequency of writing in float output file … … 783 785 ln_flork4 = .false. ! trajectories computed with a 4th order Runge-Kutta (T) 784 786 ! or computed with Blanke' scheme (F) 787 ln_ariane = .true. ! Input with Ariane tool convention(T) 788 ln_ascii = .true. ! Output with Ariane tool netcdf convention(T) or ascii file (F) 785 789 / 786 790 !----------------------------------------------------------------------- -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
r2528 r3051 52 52 !! 53 53 INTEGER :: jfl, jind ! dummy loop indices 54 REAL(wp), DIMENSION(jpnfl) :: zgifl , zgjfl , zgkfl ! index RK positions 55 REAL(wp), DIMENSION(jpnfl) :: zufl , zvfl , zwfl ! interpolated velocity at the float position 56 REAL(wp), DIMENSION(jpnfl,4) :: zrkxfl, zrkyfl, zrkzfl ! RK coefficients 54 INTEGER :: ierror ! error value 55 56 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zgifl , zgjfl , zgkfl ! index RK positions 57 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zufl , zvfl , zwfl ! interpolated velocity at the float position 58 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zrkxfl, zrkyfl, zrkzfl ! RK coefficients 57 59 !!--------------------------------------------------------------------- 60 61 ALLOCATE ( zgifl(jpnfl) , zgjfl(jpnfl) , zgkfl(jpnfl) , & 62 zufl(jpnfl) , zvfl(jpnfl) , zwfl(jpnfl) , & 63 zrkxfl(jpnfl,4), zrkyfl(jpnfl,4), zrkzfl(jpnfl,4) , STAT=ierror ) 64 ! 65 IF( ierror /= 0 ) THEN 66 WRITE(numout,*) 'flo_4rk: allocation of workspace arrays failed' 67 ENDIF 68 58 69 59 70 IF( kt == nit000 ) THEN … … 145 156 END DO 146 157 END DO 158 ! 159 DEALLOCATE( zgifl , zgjfl , zgkfl ) 160 DEALLOCATE( zufl , zvfl , zwfl ) 161 DEALLOCATE( zrkxfl , zrkyfl , zrkzfl ) 147 162 ! 148 163 END SUBROUTINE flo_4rk -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90
r2715 r3051 24 24 !! float parameters 25 25 !! ---------------- 26 INTEGER, PUBLIC , PARAMETER :: jpnfl = 23!: total number of floats during the run27 INTEGER, PUBLIC , PARAMETER :: jpnnewflo = 0!: number of floats added in a new run28 INTEGER, PUBLIC , PARAMETER :: jpnrstflo = jpnfl - jpnnewflo !: number of floats for the restart26 INTEGER, PUBLIC :: jpnfl !: total number of floats during the run 27 INTEGER, PUBLIC :: jpnnewflo !: number of floats added in a new run 28 INTEGER, PUBLIC :: jpnrstflo !: number of floats for the restart 29 29 30 30 !! float variables 31 31 !! --------------- 32 INTEGER , PUBLIC, DIMENSION(jpnfl) :: nisobfl !: =0 for a isobar float , =1 for a float following the w velocity 33 INTEGER , PUBLIC, DIMENSION(jpnfl) :: ngrpfl !: number to identify searcher group 32 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: nisobfl !: =0 for a isobar float , =1 for a float following the w velocity 33 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: ngrpfl !: number to identify searcher group 34 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: nfloat !: number to identify searcher group 34 35 35 REAL(wp), PUBLIC, DIMENSION(jpnfl) :: flxx , flyy , flzz !: long, lat, depth of float (decimal degree, m >0)36 REAL(wp), PUBLIC, DIMENSION(jpnfl) :: tpifl, tpjfl, tpkfl !: (i,j,k) indices of float position36 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: flxx , flyy , flzz !: long, lat, depth of float (decimal degree, m >0) 37 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: tpifl, tpjfl, tpkfl !: (i,j,k) indices of float position 37 38 38 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wb !: vertical velocity at previous time step (m s-1). 39 40 40 ! !!! * namelist namflo : langrangian floats * 41 LOGICAL, PUBLIC :: ln_rstflo = .FALSE. !: T/F float restart 42 LOGICAL, PUBLIC :: ln_argo = .FALSE. !: T/F argo type floats 43 LOGICAL, PUBLIC :: ln_flork4 = .FALSE. !: T/F 4th order Runge-Kutta 44 INTEGER, PUBLIC :: nn_writefl = 150 !: frequency of float output file 45 INTEGER, PUBLIC :: nn_stockfl = 450 !: frequency of float restart file 41 ! !!! * namelist namflo : langrangian floats * 42 LOGICAL, PUBLIC :: ln_rstflo = .FALSE. !: T/F float restart 43 LOGICAL, PUBLIC :: ln_argo = .FALSE. !: T/F argo type floats 44 LOGICAL, PUBLIC :: ln_flork4 = .FALSE. !: T/F 4th order Runge-Kutta 45 LOGICAL, PUBLIC :: ln_ariane = .FALSE. !: handle ariane input/output convention 46 LOGICAL, PUBLIC :: ln_flo_ascii = .FALSE. !: write in ascii (T) or in Netcdf (F) 47 48 INTEGER, PUBLIC :: nn_writefl = 150 !: frequency of float output file 49 INTEGER, PUBLIC :: nn_stockfl = 450 !: frequency of float restart file 46 50 47 51 !!---------------------------------------------------------------------- … … 56 60 !! *** FUNCTION flo_oce_alloc *** 57 61 !!---------------------------------------------------------------------- 58 ALLOCATE( wb(jpi,jpj,jpk) , STAT=flo_oce_alloc ) 62 ALLOCATE( wb(jpi,jpj,jpk) , nfloat(jpnfl) , nisobfl(jpnfl) , ngrpfl(jpnfl) , & 63 flxx(jpnfl) , flyy(jpnfl) , flzz(jpnfl) , & 64 tpifl(jpnfl) , tpjfl(jpnfl) , tpkfl(jpnfl) , STAT=flo_oce_alloc ) 59 65 ! 60 66 IF( lk_mpp ) CALL mpp_sum ( flo_oce_alloc ) -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
r2715 r3051 19 19 USE flodom ! initialisation Module 20 20 USE flowri ! float output (flo_wri routine) 21 USE florst ! float restart (flo_rst routine) 21 22 USE flo4rk ! Trajectories, Runge Kutta scheme (flo_4rk routine) 22 23 USE floblk ! Trajectories, Blanke scheme (flo_blk routine) … … 56 57 IF( lk_mpp ) CALL mppsync ! synchronization of all the processor 57 58 ! 58 IF( kt == nit000 .OR. MOD( kt, nn_writefl ) == 0 ) CALL flo_wri( kt ) ! trajectories file 59 IF( kt == nitend .OR. MOD( kt, nn_stockfl ) == 0 ) CALL flo_wri( kt ) ! restart file 59 CALL flo_wri( kt ) ! trajectories ouput 60 ! 61 CALL flo_rst( kt ) ! trajectories restart 60 62 ! 61 63 wb(:,:,:) = wn(:,:,:) ! Save the old vertical velocity field … … 70 72 !! ** Purpose : Read the namelist of floats 71 73 !!---------------------------------------------------------------------- 72 NAMELIST/namflo/ ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4 74 INTEGER :: jfl 75 ! 76 NAMELIST/namflo/ jpnfl, jpnnewflo, ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4, ln_ariane, ln_flo_ascii 73 77 !!--------------------------------------------------------------------- 74 78 ! … … 83 87 WRITE(numout,*) 84 88 WRITE(numout,*) ' Namelist floats :' 85 WRITE(numout,*) ' restart ln_rstflo = ', ln_rstflo 86 WRITE(numout,*) ' frequency of float output file nn_writefl = ', nn_writefl 87 WRITE(numout,*) ' frequency of float restart file nn_stockfl = ', nn_stockfl 88 WRITE(numout,*) ' Argo type floats ln_argo = ', ln_argo 89 WRITE(numout,*) ' Computation of T trajectories ln_flork4 = ', ln_flork4 89 WRITE(numout,*) ' number of floats jpnfl = ', jpnfl 90 WRITE(numout,*) ' number of new floats jpnflnewflo = ', jpnnewflo 91 WRITE(numout,*) ' restart ln_rstflo = ', ln_rstflo 92 WRITE(numout,*) ' frequency of float output file nn_writefl = ', nn_writefl 93 WRITE(numout,*) ' frequency of float restart file nn_stockfl = ', nn_stockfl 94 WRITE(numout,*) ' Argo type floats ln_argo = ', ln_argo 95 WRITE(numout,*) ' Computation of T trajectories ln_flork4 = ', ln_flork4 96 WRITE(numout,*) ' Use of ariane convention ln_ariane = ', ln_ariane 97 WRITE(numout,*) ' ascii output (T) or netcdf output (F) ln_flo_ascii = ', ln_flo_ascii 98 90 99 ENDIF 91 100 ! … … 93 102 IF( flo_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'flo_init : unable to allocate arrays' ) 94 103 ! 104 ! ! allocate flodom arrays 105 IF( flo_dom_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'flo_dom : unable to allocate arrays' ) 106 ! 95 107 ! ! allocate flowri arrays 96 108 IF( flo_wri_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'flo_wri : unable to allocate arrays' ) 109 ! 110 ! ! allocate florst arrays 111 IF( flo_rst_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'flo_rst : unable to allocate arrays' ) 112 ! 113 !memory allocation 114 jpnrstflo = jpnfl-jpnnewflo 115 116 !vertical axe for netcdf IOM ouput 117 DO jfl=1,jpnfl ; nfloat(jfl)=jfl ; ENDDO 118 97 119 ! 98 120 CALL flo_dom ! compute/read initial position of floats -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
r2528 r3051 4 4 !! Ocean floats : domain 5 5 !!====================================================================== 6 !! History : OPA ! 1998-07 (Y.Drillet, CLIPPER) Original code 6 !! History : OPA ! 1998-07 (Y.Drillet, CLIPPER) Original code 7 !! NEMO_3.3.1 ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): 8 ! add Ariane convention, Comsecitc changes 7 9 !!---------------------------------------------------------------------- 8 10 #if defined key_floats || defined key_esopa … … 10 12 !! 'key_floats' float trajectories 11 13 !!---------------------------------------------------------------------- 12 !! flo_dom : initialization of floats 13 !! findmesh : compute index of position 14 !! dstnce : compute distance between face mesh and floats 14 !! flo_dom : initialization of floats 15 !! add_new_floats : add new floats (long/lat/depth) 16 !! add_new_ariane_floats : add new floats with araine convention (i/j/k) 17 !! findmesh : compute index of position 18 !! dstnce : compute distance between face mesh and floats 15 19 !!---------------------------------------------------------------------- 16 20 USE oce ! ocean dynamics and tracers … … 23 27 PRIVATE 24 28 25 PUBLIC flo_dom ! routine called by floats.F90 29 PUBLIC flo_dom ! routine called by floats.F90 30 PUBLIC flo_dom_alloc ! Routine called in floats.F90 31 32 CHARACTER (len=21) :: clname1 = 'init_float' ! floats initialisation filename 33 CHARACTER (len=21) :: clname2 = 'init_float_ariane' ! ariane floats initialisation filename 34 35 36 INTEGER , ALLOCATABLE, DIMENSION(:) :: iimfl, ijmfl, ikmfl ! index mesh of floats 37 INTEGER , ALLOCATABLE, DIMENSION(:) :: idomfl, ivtest, ihtest ! - 38 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zgifl, zgjfl, zgkfl ! distances in indexes 26 39 27 40 !! * Substitutions … … 43 56 !! the longitude (degree) and the depth (m). 44 57 !!---------------------------------------------------------------------- 45 LOGICAL :: llinmesh 46 INTEGER :: ji, jj, jk ! DO loop index on 3 directions 47 INTEGER :: jfl, jfl1 ! number of floats 48 INTEGER :: inum ! logical unit for file read 49 INTEGER, DIMENSION(jpnfl) :: iimfl, ijmfl, ikmfl ! index mesh of floats 50 INTEGER, DIMENSION(jpnfl) :: idomfl, ivtest, ihtest ! - - 51 REAL(wp) :: zdxab, zdyad 52 REAL(wp), DIMENSION(jpnnewflo+1) :: zgifl, zgjfl, zgkfl 58 INTEGER :: jfl ! dummy loop 59 INTEGER :: inum ! logical unit for file read 53 60 !!--------------------------------------------------------------------- 54 61 … … 59 66 IF(lwp) WRITE(numout,*) ' jpnfl = ',jpnfl 60 67 61 IF(ln_rstflo) THEN 68 !-------------------------! 69 ! FLOAT RESTART FILE READ ! 70 !-------------------------! 71 IF( ln_rstflo )THEN 72 62 73 IF(lwp) WRITE(numout,*) ' float restart file read' 63 74 64 75 ! open the restart file 76 !---------------------- 65 77 CALL ctl_opn( inum, 'restart_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 66 78 67 79 ! read of the restart file 68 READ(inum )( tpifl (jfl), jfl=1, jpnrstflo), &80 READ(inum,*) ( tpifl (jfl), jfl=1, jpnrstflo), & 69 81 ( tpjfl (jfl), jfl=1, jpnrstflo), & 70 82 ( tpkfl (jfl), jfl=1, jpnrstflo), & … … 74 86 75 87 ! if we want a surface drift ( like PROVOR floats ) 76 IF( ln_argo ) THEN 77 DO jfl = 1, jpnrstflo 78 nisobfl(jfl) = 0 79 END DO 80 ENDIF 81 82 IF(lwp) WRITE(numout,*)' flo_dom: END of florstlec' 88 IF( ln_argo ) nisobfl(1:jpnrstflo) = 0 83 89 84 90 ! It is possible to add new floats. 85 IF(lwp) WRITE(numout,*)' flo_dom:jpnfl jpnrstflo ',jpnfl,jpnrstflo 86 IF( jpnfl > jpnrstflo ) THEN 87 ! open the init file 88 CALL ctl_opn( inum, 'init_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 89 DO jfl = jpnrstflo+1, jpnfl 90 READ(inum,*) flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),jfl1 91 END DO 92 CLOSE(inum) 93 IF(lwp) WRITE(numout,*)' flodom: END reading init_float file' 91 !--------------------------------- 92 IF( jpnfl > jpnrstflo )THEN 93 94 IF(lwp) WRITE(numout,*) ' add new floats' 95 96 IF( ln_ariane )THEN !Add new floats with ariane convention 97 CALL flo_add_new_ariane_floats(jpnrstflo+1,jpnfl) 98 ELSE !Add new floats with long/lat convention 99 CALL flo_add_new_floats(jpnrstflo+1,jpnfl) 100 ENDIF 101 ENDIF 102 103 !--------------------------------------! 104 ! FLOAT INITILISATION: NO RESTART FILE ! 105 !--------------------------------------! 106 ELSE !ln_rstflo 107 108 IF( ln_ariane )THEN !Add new floats with ariane convention 109 CALL flo_add_new_ariane_floats(1,jpnfl) 110 ELSE !Add new floats with long/lat convention 111 CALL flo_add_new_floats(1,jpnfl) 112 ENDIF 113 114 ENDIF 94 115 95 ! Test to find the grid point coordonate with the geographical position 96 DO jfl = jpnrstflo+1, jpnfl 97 ihtest(jfl) = 0 98 ivtest(jfl) = 0 99 ikmfl(jfl) = 0 116 END SUBROUTINE flo_dom 117 118 SUBROUTINE flo_add_new_floats(kfl_start, kfl_end) 119 !! ------------------------------------------------------------- 120 !! *** SUBROUTINE add_new_arianefloats *** 121 !! 122 !! ** Purpose : 123 !! 124 !! First initialisation of floats 125 !! the initials positions of floats are written in a file 126 !! with a variable to know if it is a isobar float a number 127 !! to identified who want the trajectories of this float and 128 !! an index for the number of the float 129 !! open the init file 130 !! 131 !! ** Method : 132 !!---------------------------------------------------------------------- 133 INTEGER, INTENT(in) :: kfl_start, kfl_end 134 !! 135 INTEGER :: inum ! file unit 136 INTEGER :: jfl,ji, jj, jk ! dummy loop indices 137 INTEGER :: itrash ! trash var for reading 138 INTEGER :: ifl ! number of floats to read 139 REAL(wp) :: zdxab, zdyad 140 LOGICAL :: llinmesh 141 CHARACTER(len=80) :: cltmp 142 !!--------------------------------------------------------------------- 143 ifl = kfl_end-kfl_start+1 144 145 ! we get the init values 146 !----------------------- 147 CALL ctl_opn( inum , clname1, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 148 DO jfl = kfl_start,kfl_end 149 READ(inum,*) flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),itrash 150 if(lwp)write(numout,*)'read:',jfl,flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),itrash ; call flush(numout) 151 END DO 152 CLOSE(inum) 153 154 ! Test to find the grid point coordonate with the geographical position 155 !---------------------------------------------------------------------- 156 DO jfl = kfl_start,kfl_end 157 ihtest(jfl) = 0 158 ivtest(jfl) = 0 159 ikmfl(jfl) = 0 100 160 # if defined key_mpp_mpi 101 102 103 # else 104 105 161 DO ji = MAX(nldi,2), nlei 162 DO jj = MAX(nldj,2), nlej ! NO vector opt. 163 # else 164 DO ji = 2, jpi 165 DO jj = 2, jpj ! NO vector opt. 106 166 # endif 107 ! For each float we find the indexes of the mesh 108 CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1), & 109 glamf(ji-1,jj ),gphif(ji-1,jj ), & 110 glamf(ji ,jj ),gphif(ji ,jj ), & 111 glamf(ji ,jj-1),gphif(ji ,jj-1), & 112 flxx(jfl) ,flyy(jfl) , & 113 glamt(ji ,jj ),gphit(ji ,jj ), llinmesh) 114 IF(llinmesh) THEN 115 iimfl(jfl) = ji 116 ijmfl(jfl) = jj 117 ihtest(jfl) = ihtest(jfl)+1 118 DO jk = 1, jpk-1 119 IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN 120 ikmfl(jfl) = jk 121 ivtest(jfl) = ivtest(jfl) + 1 122 ENDIF 123 END DO 167 ! For each float we find the indexes of the mesh 168 CALL flo_findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1), & 169 glamf(ji-1,jj ),gphif(ji-1,jj ), & 170 glamf(ji ,jj ),gphif(ji ,jj ), & 171 glamf(ji ,jj-1),gphif(ji ,jj-1), & 172 flxx(jfl) ,flyy(jfl) , & 173 glamt(ji ,jj ),gphit(ji ,jj ), llinmesh) 174 IF( llinmesh )THEN 175 iimfl(jfl) = ji 176 ijmfl(jfl) = jj 177 ihtest(jfl) = ihtest(jfl)+1 178 DO jk = 1, jpk-1 179 IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN 180 ikmfl(jfl) = jk 181 ivtest(jfl) = ivtest(jfl) + 1 124 182 ENDIF 125 183 END DO 126 END DO127 IF(lwp) WRITE(numout,*)' flo_dom: END findmesh'128 129 ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1130 IF( ihtest(jfl) == 0 ) THEN131 iimfl(jfl) = -1132 ijmfl(jfl) = -1133 184 ENDIF 134 185 END DO 186 END DO 187 188 ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1 189 IF( ihtest(jfl) == 0 ) THEN 190 iimfl(jfl) = -1 191 ijmfl(jfl) = -1 192 ENDIF 193 END DO 194 195 !Test if each float is in one and only one proc 196 !---------------------------------------------- 197 IF( lk_mpp ) THEN 198 CALL mpp_sum(ihtest,jpnfl) 199 CALL mpp_sum(ivtest,jpnfl) 200 ENDIF 201 DO jfl = kfl_start,kfl_end 202 203 IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1) ) THEN 204 WRITE(cltmp,'(A10,i4.4,A20)' )'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 205 CALL ctl_stop('STOP',TRIM(cltmp) ) 206 ENDIF 207 IF( (ihtest(jfl) == 0) ) THEN 208 WRITE(cltmp,'(A10,i4.4,A20)' )'THE FLOAT',jfl,' IS IN NO MESH' 209 CALL ctl_stop('STOP',TRIM(cltmp) ) 210 ENDIF 211 END DO 212 213 ! We compute the distance between the float and the face of the mesh 214 !------------------------------------------------------------------- 215 DO jfl = kfl_start,kfl_end 216 217 ! Made only if the float is in the domain of the processor 218 IF( (iimfl(jfl) >= 0) .AND. (ijmfl(jfl) >= 0) ) THEN 219 220 ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST 221 idomfl(jfl) = 0 222 IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl) = 1 223 224 ! Computation of the distance between the float and the faces of the mesh 225 ! zdxab 226 ! . 227 ! B----.---------C 228 ! | . | 229 ! |<------>flo | 230 ! | ^ | 231 ! | |.....|....zdyad 232 ! | | | 233 ! A--------|-----D 234 ! 235 zdxab = flo_dstnce( flxx(jfl), flyy(jfl), glamf(iimfl(jfl)-1,ijmfl(jfl)-1), flyy(jfl) ) 236 zdyad = flo_dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) ) 237 238 ! Translation of this distances (in meter) in indexes 239 zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 240 zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 241 zgkfl(jfl) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl)) & 242 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & 243 & - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) ) & 244 & + (( flzz(jfl)-fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1)) & 245 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & 246 & - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) 247 ELSE 248 zgifl(jfl) = 0.e0 249 zgjfl(jfl) = 0.e0 250 zgkfl(jfl) = 0.e0 251 ENDIF 252 253 END DO 254 255 ! The sum of all the arrays zgifl, zgjfl, zgkfl give 3 arrays with the positions of all the floats. 256 IF( lk_mpp ) THEN 257 CALL mpp_sum( zgjfl, ifl ) ! sums over the global domain 258 CALL mpp_sum( zgkfl, ifl ) 259 ENDIF 135 260 136 ! A zero in the sum of the arrays "ihtest" and "ivtest" 137 # if defined key_mpp_mpi 138 CALL mpp_sum(ihtest,jpnfl) 139 CALL mpp_sum(ivtest,jpnfl) 140 # endif 141 DO jfl = jpnrstflo+1, jpnfl 142 IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1) ) THEN 143 IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 144 STOP 145 ENDIF 146 IF( (ihtest(jfl) == 0) ) THEN 147 IF(lwp) WRITE(numout,*)'THE FLOAT',jfl,' IS IN NO MESH' 148 STOP 149 ENDIF 150 END DO 151 152 ! We compute the distance between the float and the face of the mesh 153 DO jfl = jpnrstflo+1, jpnfl 154 ! Made only if the float is in the domain of the processor 155 IF( (iimfl(jfl) >= 0) .AND. (ijmfl(jfl) >= 0) ) THEN 156 157 ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST 158 159 idomfl(jfl) = 0 160 IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl) = 1 161 162 ! Computation of the distance between the float and the faces of the mesh 163 ! zdxab 164 ! . 165 ! B----.---------C 166 ! | . | 167 ! |<------>flo | 168 ! | ^ | 169 ! | |.....|....zdyad 170 ! | | | 171 ! A--------|-----D 172 ! 173 174 zdxab = dstnce( flxx(jfl), flyy(jfl), glamf(iimfl(jfl)-1,ijmfl(jfl)-1), flyy(jfl) ) 175 zdyad = dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) ) 176 177 ! Translation of this distances (in meter) in indexes 178 179 zgifl(jfl-jpnrstflo)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 180 zgjfl(jfl-jpnrstflo)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 181 zgkfl(jfl-jpnrstflo) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl)) & 182 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & 183 & - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) ) & 184 & + (( flzz(jfl)-fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1)) & 185 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & 186 & - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) 187 ELSE 188 zgifl(jfl-jpnrstflo) = 0.e0 189 zgjfl(jfl-jpnrstflo) = 0.e0 190 zgkfl(jfl-jpnrstflo) = 0.e0 191 ENDIF 192 END DO 193 194 ! The sum of all the arrays zgifl, zgjfl, zgkfl give 3 arrays with the positions of all the floats. 195 IF( lk_mpp ) THEN 196 CALL mpp_sum( zgjfl, jpnnewflo ) ! sums over the global domain 197 CALL mpp_sum( zgkfl, jpnnewflo ) 198 IF(lwp) WRITE(numout,*) (zgifl(jfl),jfl=1,jpnnewflo) 199 IF(lwp) WRITE(numout,*) (zgjfl(jfl),jfl=1,jpnnewflo) 200 IF(lwp) WRITE(numout,*) (zgkfl(jfl),jfl=1,jpnnewflo) 201 ENDIF 202 203 DO jfl = jpnrstflo+1, jpnfl 204 tpifl(jfl) = zgifl(jfl-jpnrstflo) 205 tpjfl(jfl) = zgjfl(jfl-jpnrstflo) 206 tpkfl(jfl) = zgkfl(jfl-jpnrstflo) 207 END DO 208 ENDIF 209 ELSE 210 IF(lwp) WRITE(numout,*) ' init_float read ' 211 212 ! First initialisation of floats 213 ! the initials positions of floats are written in a file 214 ! with a variable to know if it is a isobar float a number 215 ! to identified who want the trajectories of this float and 216 ! an index for the number of the float 217 ! open the init file 218 CALL ctl_opn( inum, 'init_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 219 READ(inum) (flxx(jfl) , jfl=1, jpnfl), & 220 (flyy(jfl) , jfl=1, jpnfl), & 221 (flzz(jfl) , jfl=1, jpnfl), & 222 (nisobfl(jfl), jfl=1, jpnfl), & 223 (ngrpfl(jfl) , jfl=1, jpnfl) 224 CLOSE(inum) 225 226 ! Test to find the grid point coordonate with the geographical position 227 DO jfl = 1, jpnfl 228 ihtest(jfl) = 0 229 ivtest(jfl) = 0 230 ikmfl(jfl) = 0 231 # if defined key_mpp_mpi 232 DO ji = MAX(nldi,2), nlei 233 DO jj = MAX(nldj,2), nlej ! NO vector opt. 234 # else 235 DO ji = 2, jpi 236 DO jj = 2, jpj ! NO vector opt. 237 # endif 238 ! for each float we find the indexes of the mesh 239 240 CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1), & 241 glamf(ji-1,jj ),gphif(ji-1,jj ), & 242 glamf(ji ,jj ),gphif(ji ,jj ), & 243 glamf(ji ,jj-1),gphif(ji ,jj-1), & 244 flxx(jfl) ,flyy(jfl) , & 245 glamt(ji ,jj ),gphit(ji ,jj ), llinmesh) 246 IF(llinmesh) THEN 247 iimfl(jfl) = ji 248 ijmfl(jfl) = jj 249 ihtest(jfl) = ihtest(jfl)+1 250 DO jk = 1, jpk-1 251 IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN 252 ikmfl(jfl) = jk 253 ivtest(jfl) = ivtest(jfl) + 1 254 ENDIF 255 END DO 256 ENDIF 257 END DO 258 END DO 259 260 ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1 261 IF( ihtest(jfl) == 0 ) THEN 262 iimfl(jfl) = -1 263 ijmfl(jfl) = -1 264 ENDIF 265 END DO 266 267 ! A zero in the sum of the arrays "ihtest" and "ivtest" 268 IF( lk_mpp ) CALL mpp_sum(ihtest,jpnfl) ! sums over the global domain 269 IF( lk_mpp ) CALL mpp_sum(ivtest,jpnfl) 270 271 DO jfl = 1, jpnfl 272 IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1 )) THEN 273 IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 274 ENDIF 275 IF( ihtest(jfl) == 0 ) THEN 276 IF(lwp) WRITE(numout,*)'THE FLOAT',jfl,' IS IN NO MESH' 277 ENDIF 278 END DO 279 280 ! We compute the distance between the float and the face of the mesh 281 DO jfl = 1, jpnfl 282 ! Made only if the float is in the domain of the processor 283 IF( (iimfl(jfl) >= 0 ) .AND. ( ijmfl(jfl) >= 0 ) ) THEN 284 285 ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST 286 287 idomfl(jfl) = 0 288 IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl)=1 289 290 ! Computation of the distance between the float 291 ! and the faces of the mesh 292 ! zdxab 293 ! . 294 ! B----.---------C 295 ! | . | 296 ! |<------>flo | 297 ! | ^ | 298 ! | |.....|....zdyad 299 ! | | | 300 ! A--------|-----D 301 302 zdxab = dstnce(flxx(jfl),flyy(jfl),glamf(iimfl(jfl)-1,ijmfl(jfl)-1),flyy(jfl)) 303 zdyad = dstnce(flxx(jfl),flyy(jfl),flxx(jfl),gphif(iimfl(jfl)-1,ijmfl(jfl)-1)) 304 305 ! Translation of this distances (in meter) in indexes 306 307 tpifl(jfl) = (iimfl(jfl)-0.5)+zdxab/ e1u(iimfl(jfl)-1,ijmfl(jfl))+(mig(1)-jpizoom) 308 tpjfl(jfl) = (ijmfl(jfl)-0.5)+zdyad/ e2v(iimfl(jfl),ijmfl(jfl)-1)+(mjg(1)-jpjzoom) 309 tpkfl(jfl) = (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl))*(ikmfl(jfl)) & 310 / (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl))) & 311 + (flzz(jfl) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)))*(ikmfl(jfl)+1) & 312 / (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl))) 313 ELSE 314 tpifl (jfl) = 0.e0 315 tpjfl (jfl) = 0.e0 316 tpkfl (jfl) = 0.e0 317 idomfl(jfl) = 0 318 ENDIF 319 END DO 320 321 ! The sum of all the arrays tpifl, tpjfl, tpkfl give 3 arrays with the positions of all the floats. 322 IF( lk_mpp ) CALL mpp_sum( tpifl , jpnfl ) ! sums over the global domain 323 IF( lk_mpp ) CALL mpp_sum( tpjfl , jpnfl ) 324 IF( lk_mpp ) CALL mpp_sum( tpkfl , jpnfl ) 325 IF( lk_mpp ) CALL mpp_sum( idomfl, jpnfl ) 326 ENDIF 327 328 ! Print the initial positions of the floats 261 DO jfl = kfl_start,kfl_end 262 tpifl(jfl) = zgifl(jfl) 263 tpjfl(jfl) = zgjfl(jfl) 264 tpkfl(jfl) = zgkfl(jfl) 265 END DO 266 267 ! WARNING : initial position not in the sea 329 268 IF( .NOT. ln_rstflo ) THEN 330 ! WARNING : initial position not in the sea 331 DO jfl = 1, jpnfl 269 DO jfl = kfl_start,kfl_end 332 270 IF( idomfl(jfl) == 1 ) THEN 333 271 IF(lwp) WRITE(numout,*)'*****************************' … … 341 279 ENDIF 342 280 343 END SUBROUTINE flo_dom 344 345 346 SUBROUTINE findmesh( pax, pay, pbx, pby, & 347 pcx, pcy, pdx, pdy, & 348 px ,py ,ptx, pty, ldinmesh ) 281 END SUBROUTINE flo_add_new_floats 282 283 SUBROUTINE flo_add_new_ariane_floats(kfl_start, kfl_end) 284 !! ------------------------------------------------------------- 285 !! *** SUBROUTINE add_new_arianefloats *** 286 !! 287 !! ** Purpose : 288 !! First initialisation of floats with ariane convention 289 !! 290 !! The indexes are read directly from file (warning ariane 291 !! convention, are refered to 292 !! U,V,W grids - and not T-) 293 !! The isobar advection is managed with the sign of tpkfl ( >0 -> 3D 294 !! advection, <0 -> 2D) 295 !! Some variables are not read, as - gl : time index; 4th 296 !! column 297 !! - transport : transport ; 5th 298 !! column 299 !! and paste in the jtrash var 300 !! At the end, ones need to replace the indexes on T grid 301 !! RMQ : there is no float groups identification ! 302 !! 303 !! 304 !! ** Method : 305 !!---------------------------------------------------------------------- 306 INTEGER, INTENT(in) :: kfl_start, kfl_end 307 !! 308 INTEGER :: inum ! file unit 309 INTEGER :: ierr, ifl 310 INTEGER :: jfl, jfl1 ! dummy loop indices 311 INTEGER :: itrash ! trash var for reading 312 CHARACTER(len=80) :: cltmp 313 314 !!---------------------------------------------------------------------- 315 nisobfl(kfl_start:kfl_end) = 1 ! we assume that by default we want 3D advection 316 317 ifl = kfl_end - kfl_start + 1 ! number of floats to read 318 319 ! we check that the number of floats in the init_file are consistant with the namelist 320 IF( lwp ) THEN 321 322 jfl1=0 323 ierr=0 324 CALL ctl_opn( inum, clname2, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .TRUE., 1 ) 325 DO WHILE (ierr .EQ. 0) 326 jfl1=jfl1+1 327 READ(inum,*, iostat=ierr) 328 END DO 329 CLOSE(inum) 330 IF( (jfl1-1) .NE. ifl )THEN 331 WRITE(cltmp,'(A25,A20,A3,i4.4,A10,i4.4)')"the number of floats in ",TRIM(clname2), & 332 " = ",jfl1," is not equal to jfl= ",ifl 333 CALL ctl_stop('STOP',TRIM(cltmp) ) 334 ENDIF 335 336 ENDIF 337 338 ! we get the init values 339 CALL ctl_opn( inum, clname2, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .TRUE., 1 ) 340 DO jfl = kfl_start, kfl_end 341 READ(inum,*) tpifl(jfl),tpjfl(jfl),tpkfl(jfl),itrash, itrash 342 343 IF ( tpkfl(jfl) .LT. 0. ) nisobfl(jfl) = 0 !set the 2D advection according to init_float 344 ngrpfl(jfl)=jfl 345 END DO 346 347 ! conversion from ariane index to T grid index 348 tpkfl(kfl_start:kfl_end) = abs(tpkfl)-0.5 ! reversed vertical axis 349 tpifl(kfl_start:kfl_end) = tpifl+0.5 350 tpjfl(kfl_start:kfl_end) = tpjfl+0.5 351 352 353 END SUBROUTINE flo_add_new_ariane_floats 354 355 356 SUBROUTINE flo_findmesh( pax, pay, pbx, pby, & 357 pcx, pcy, pdx, pdy, & 358 px ,py ,ptx, pty, ldinmesh ) 349 359 !! ------------------------------------------------------------- 350 360 !! *** ROUTINE findmesh *** … … 402 412 ENDIF 403 413 ! 404 END SUBROUTINE f indmesh405 406 407 FUNCTION dstnce( pla1, phi1, pla2, phi2 )414 END SUBROUTINE flo_findmesh 415 416 417 FUNCTION flo_dstnce( pla1, phi1, pla2, phi2 ) 408 418 !! ------------------------------------------------------------- 409 419 !! *** Function dstnce *** … … 415 425 REAL(wp), INTENT(in) :: pla1, phi1, pla2, phi2 ! ??? 416 426 !! 417 REAL(wp) :: 418 REAL(wp) :: 427 REAL(wp) :: dly1, dly2, dlx1, dlx2, dlx, dls, dld, dpi 428 REAL(wp) :: flo_dstnce 419 429 !!--------------------------------------------------------------------- 420 430 ! 421 dpi = 2. * ASIN(1.)422 dls = dpi / 180. 431 dpi = 2._wp * ASIN(1._wp) 432 dls = dpi / 180._wp 423 433 dly1 = phi1 * dls 424 434 dly2 = phi2 * dls … … 428 438 dlx = SIN(dly1) * SIN(dly2) + COS(dly1) * COS(dly2) * COS(dlx2-dlx1) 429 439 ! 430 IF( ABS(dlx) > 1.0 ) dlx = 1.0 431 ! 432 dld = ATAN(DSQRT( ( 1-dlx )/( 1+dlx ) )) * 222.24 / dls 433 dstnce = dld * 1000. 434 ! 435 END FUNCTION dstnce 436 437 # else 440 IF( ABS(dlx) > 1.0_wp ) dlx = 1.0_wp 441 ! 442 dld = ATAN(DSQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls 443 flo_dstnce = dld * 1000._wp 444 ! 445 END FUNCTION flo_dstnce 446 447 INTEGER FUNCTION flo_dom_alloc() 448 !!---------------------------------------------------------------------- 449 !! *** FUNCTION flo_dom_alloc *** 450 !!---------------------------------------------------------------------- 451 452 ALLOCATE( iimfl(jpnfl) , ijmfl(jpnfl) , ikmfl(jpnfl) , & 453 idomfl(jpnfl), ivtest(jpnfl), ihtest(jpnfl), & 454 zgifl(jpnfl) , zgjfl(jpnfl) , zgkfl(jpnfl) , STAT=flo_dom_alloc ) 455 ! 456 IF( lk_mpp ) CALL mpp_sum ( flo_dom_alloc ) 457 IF( flo_dom_alloc /= 0 ) CALL ctl_warn('flo_dom_alloc: failed to allocate arrays') 458 END FUNCTION flo_dom_alloc 459 460 461 #else 438 462 !!---------------------------------------------------------------------- 439 463 !! Default option Empty module … … 441 465 CONTAINS 442 466 SUBROUTINE flo_dom ! Empty routine 467 WRITE(*,*) 'flo_dom: : You should not have seen this print! error?' 443 468 END SUBROUTINE flo_dom 444 469 #endif -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
r2715 r3051 2 2 !!====================================================================== 3 3 !! *** MODULE flowri *** 4 !! lagrangian floats : outputs 4 !! 5 !! write floats trajectory in ascii ln_flo_ascii = T 6 !! or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F 7 !! 8 !! 5 9 !!====================================================================== 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 10 !! History : 11 !! 8.0 ! 99-09 (Y. Drillet) : Original code 12 !! ! 00-06 (J.-M. Molines) : Profiling floats for CLS 13 !! 8.5 ! 02-10 (A. Bozec) F90 : Free form and module 14 !! 3.2 ! 10-08 (slaw, cbricaud): netcdf outputs and others 9 15 !!---------------------------------------------------------------------- 10 16 #if defined key_floats || defined key_esopa … … 12 18 !! 'key_floats' float trajectories 13 19 !!---------------------------------------------------------------------- 14 !! flowri : write trajectories of floats in file 15 !! ----------------------------------------------------------------------20 21 !! * Modules used 16 22 USE flo_oce ! ocean drifting floats 17 23 USE oce ! ocean dynamics and tracers … … 19 25 USE lib_mpp ! distribued memory computing library 20 26 USE in_out_manager ! I/O manager 27 USE phycst ! physic constants 28 USE dianam ! build name of file (routine) 29 USE ioipsl 30 USE iom ! I/O library 31 21 32 22 33 IMPLICIT NONE 23 34 PRIVATE 24 35 25 PUBLIC 26 PUBLIC 27 28 INTEGER :: jfl! number of floats29 INTEGER :: numflo ! logical unit for drifting floats36 PUBLIC flo_wri ! routine called by floats.F90 37 PUBLIC flo_wri_alloc ! routine called by floats.F90 38 39 INTEGER :: jfl ! number of floats 40 CHARACTER (len=80) :: clname ! netcdf output filename 30 41 31 42 ! Following are only workspace arrays but shape is not (jpi,jpj) and 32 43 ! therefore make them module arrays rather than replacing with wrk_nemo 33 44 ! member arrays. 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ztemp, zsal ! 2D workspace 45 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zlon , zlat, zdep ! 2D workspace 46 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ztem , zsal, zrho ! 2D workspace 35 47 36 48 !! * Substitutions 37 49 # include "domzgr_substitute.h90" 38 50 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 40 !! $Id$ 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 !!---------------------------------------------------------------------- 51 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 52 !! $Header: 53 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 54 !!---------------------------------------------------------------------- 55 43 56 CONTAINS 44 57 45 INTEGER FUNCTION flo_wri_alloc 58 INTEGER FUNCTION flo_wri_alloc() 46 59 !!------------------------------------------------------------------- 47 60 !! *** FUNCTION flo_wri_alloc *** 48 61 !!------------------------------------------------------------------- 49 ALLOCATE( ztemp(jpk,jpnfl) , zsal(jpk,jpnfl) , STAT=flo_wri_alloc) 50 ! 62 ALLOCATE( ztem(jpnfl) , zsal(jpnfl) , zrho(jpnfl) , & 63 zlon(jpnfl) , zlat(jpnfl) , zdep(jpnfl) , STAT=flo_wri_alloc) 64 ! 51 65 IF( lk_mpp ) CALL mpp_sum ( flo_wri_alloc ) 52 66 IF( flo_wri_alloc /= 0 ) CALL ctl_warn('flo_wri_alloc: failed to allocate arrays.') 53 67 END FUNCTION flo_wri_alloc 54 68 55 56 69 SUBROUTINE flo_wri( kt ) 57 !!------------------------------------------------------------------- 58 !! *** ROUTINE flo_wri 70 !!--------------------------------------------------------------------- 71 !! *** ROUTINE flo_wri *** 59 72 !! 60 !! ** Purpose : Write position of floats in "trajec_float" file 61 !! and the temperature and salinity at this position 73 !! ** Purpose : Write position of floats in "trajec_float.nc",according 74 !! to ARIANE TOOLS (http://stockage.univ-brest.fr/~grima/Ariane/ ) n 75 !! nomenclature 76 !! 62 77 !! 63 !! ** Method : The frequency is nn_writefl 78 !! ** Method : The frequency of ??? is nwritefl 79 !! 64 80 !!---------------------------------------------------------------------- 65 INTEGER :: kt ! time step 66 !! 67 CHARACTER (len=21) :: clname 68 INTEGER :: inum ! temporary logical unit for restart file 69 INTEGER :: iafl, ibfl, icfl, ia1fl, ib1fl, ic1fl, jfl, irecflo 70 INTEGER :: iafloc, ibfloc, ia1floc, ib1floc, iafln, ibfln 71 INTEGER :: ic, jc , jpn 72 INTEGER, DIMENSION ( jpnij ) :: iproc 73 REAL(wp) :: zafl, zbfl, zcfl, zdtj 74 REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11 75 !!--------------------------------------------------------------------- 81 !! * Arguments 82 INTEGER :: kt ! time step 83 84 !! * Local declarations 85 INTEGER :: iafl , ibfl , icfl ! temporary integer 86 INTEGER :: ia1fl, ib1fl, ic1fl ! " 87 INTEGER :: iafloc,ibfloc,ia1floc,ib1floc ! " 88 INTEGER :: irec, irecflo 89 90 REAL(wp) :: zafl,zbfl,zcfl ! temporary real 91 REAL(wp) :: ztime ! " 92 93 INTEGER, DIMENSION(2) :: icount 94 INTEGER, DIMENSION(2) :: istart 95 INTEGER, DIMENSION(1) :: ish 96 INTEGER, DIMENSION(2) :: ish2 97 !!---------------------------------------------------------------------- 76 98 77 IF( kt == nit000 .OR. MOD( kt,nn_writefl) == 0 ) THEN 78 79 ! header of output floats file 80 81 IF(lwp) THEN 82 WRITE(numout,*) 83 WRITE(numout,*) 'flo_wri : write in trajec_float file ' 84 WRITE(numout,*) '~~~~~~~ ' 85 ENDIF 86 87 ! open the file numflo 88 CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 89 90 IF( kt == nit000 ) THEN 91 irecflo = NINT( (nitend-nit000) / FLOAT(nn_writefl) ) 92 IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nn_writefl 93 ENDIF 94 zdtj = rdt / 86400._wp 95 96 ! translation of index position in geographical position 99 !----------------------------------------------------- 100 ! I- Save positions, temperature, salinty and density 101 !----------------------------------------------------- 102 zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0 103 ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0 104 105 DO jfl = 1, jpnfl 106 107 iafl = INT (tpifl(jfl)) ! I-index of the nearest point before 108 ibfl = INT (tpjfl(jfl)) ! J-index of the nearest point before 109 icfl = INT (tpkfl(jfl)) ! K-index of the nearest point before 110 ia1fl = iafl + 1 ! I-index of the nearest point after 111 ib1fl = ibfl + 1 ! J-index of the nearest point after 112 ic1fl = icfl + 1 ! K-index of the nearest point after 113 zafl = tpifl(jfl) - REAL(iafl,wp) ! distance ????? 114 zbfl = tpjfl(jfl) - REAL(ibfl,wp) ! distance ????? 115 zcfl = tpkfl(jfl) - REAL(icfl,wp) ! distance ????? 97 116 98 117 IF( lk_mpp ) THEN 99 DO jfl = 1, jpnfl 100 iafl = INT ( tpifl(jfl) ) 101 ibfl = INT ( tpjfl(jfl) ) 102 icfl = INT ( tpkfl(jfl) ) 103 iafln = NINT( tpifl(jfl) ) 104 ibfln = NINT( tpjfl(jfl) ) 105 ia1fl = iafl + 1 106 ib1fl = ibfl + 1 107 ic1fl = icfl + 1 108 zafl = tpifl(jfl) - FLOAT( iafl ) 109 zbfl = tpjfl(jfl) - FLOAT( ibfl ) 110 zcfl = tpkfl(jfl) - FLOAT( icfl ) 111 IF( iafl >= mig(nldi)-jpizoom+1 .AND. iafl <= mig(nlei)-jpizoom+1 .AND. & 112 & ibfl >= mjg(nldj)-jpjzoom+1 .AND. ibfl <= mjg(nlej)-jpjzoom+1 ) THEN 113 114 ! local index 115 116 iafloc = iafl -(mig(1)-jpizoom+1) + 1 117 ibfloc = ibfl -(mjg(1)-jpjzoom+1) + 1 118 ia1floc = iafloc + 1 119 ib1floc = ibfloc + 1 120 121 flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 122 & + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 123 flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 124 & + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 125 flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 126 127 ! Change by Alexandra Bozec et Jean-Philippe Boulanger 128 ! We save the instantaneous profile of T and S of the column 129 ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 130 ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 131 ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 132 zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 133 ELSE 134 flxx(jfl) = 0. 135 flyy(jfl) = 0. 136 flzz(jfl) = 0. 137 ztemp(1:jpk,jfl) = 0. 138 zsal (1:jpk,jfl) = 0. 139 ENDIF 140 END DO 141 142 CALL mpp_sum( flxx, jpnfl ) ! sums over the global domain 143 CALL mpp_sum( flyy, jpnfl ) 144 CALL mpp_sum( flzz, jpnfl ) 145 ! these 2 lines have accendentaly been removed from ATL6-V8 run hence 146 ! giving 0 salinity and temperature on the float trajectory 147 !bug RB 148 !compilation failed in mpp 149 ! CALL mpp_sum( ztemp, jpk*jpnfl ) 150 ! CALL mpp_sum( zsal , jpk*jpnfl ) 151 152 ELSE 153 DO jfl = 1, jpnfl 154 iafl = INT (tpifl(jfl)) 155 ibfl = INT (tpjfl(jfl)) 156 icfl = INT (tpkfl(jfl)) 157 iafln = NINT(tpifl(jfl)) 158 ibfln = NINT(tpjfl(jfl)) 159 ia1fl = iafl+1 160 ib1fl = ibfl+1 161 ic1fl = icfl+1 162 zafl = tpifl(jfl) - FLOAT(iafl) 163 zbfl = tpjfl(jfl) - FLOAT(ibfl) 164 zcfl = tpkfl(jfl) - FLOAT(icfl) 165 iafloc = iafl 166 ibfloc = ibfl 118 119 iafloc = mi1( iafl ) 120 ibfloc = mj1( ibfl ) 121 122 IF( nldi <= iafloc .AND. iafloc <= nlei .AND. & 123 & nldj <= ibfloc .AND. ibfloc <= nlej ) THEN 124 125 !the float is inside of current proc's area 167 126 ia1floc = iafloc + 1 168 127 ib1floc = ibfloc + 1 169 ! 170 flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 171 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 172 flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 173 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 174 flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 175 !ALEX 176 ! Astuce pour ne pas avoir des flotteurs qui se baladent sur IDL 177 zxxu_11 = glamt(iafloc ,ibfloc ) 178 zxxu_10 = glamt(iafloc ,ib1floc) 179 zxxu_01 = glamt(ia1floc,ibfloc ) 180 zxxu = glamt(ia1floc,ib1floc) 181 182 IF( iafloc == 52 ) zxxu_10 = -181 183 IF( iafloc == 52 ) zxxu_11 = -181 184 flxx(jfl)=(1.-zafl)*(1.-zbfl)* zxxu_11 + (1.-zafl)* zbfl * zxxu_10 & 185 + zafl *(1.-zbfl)* zxxu_01 + zafl * zbfl * zxxu 186 !ALEX 187 ! Change by Alexandra Bozec et Jean-Philippe Boulanger 188 ! We save the instantaneous profile of T and S of the column 189 ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 190 ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 191 ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 192 zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 193 END DO 128 129 !save position of the float 130 zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 131 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 132 zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 133 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 134 zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 135 136 !save temperature, salinity and density at this position 137 ztem(jfl) = tn(iafloc,ibfloc,icfl) 138 zsal (jfl) = sn(iafloc,ibfloc,icfl) 139 zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 140 141 ENDIF 142 143 ELSE ! mono proc case 144 145 iafloc = iafl 146 ibfloc = ibfl 147 ia1floc = iafloc + 1 148 ib1floc = ibfloc + 1 149 150 !save position of the float 151 zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 152 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 153 zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 154 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 155 zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 156 157 ztem(jfl) = tn(iafloc,ibfloc,icfl) 158 zsal(jfl) = sn(iafloc,ibfloc,icfl) 159 zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 160 194 161 ENDIF 195 162 196 ! 197 WRITE(numflo) flxx,flyy,flzz,nisobfl,ngrpfl,ztemp,zsal, FLOAT(ndastp) 198 !! 199 !! case when profiles are dumped. In order to save memory, dumps are 200 !! done level by level. 201 ! IF (mod(kt,nflclean) == 0.) THEN 202 !! IF ( nwflo == nwprofil ) THEN 203 ! DO jk = 1,jpk 204 ! DO jfl=1,jpnfl 205 ! iafl= INT(tpifl(jfl)) 206 ! ibfl=INT(tpjfl(jfl)) 207 ! iafln=NINT(tpifl(jfl)) 208 ! ibfln=NINT(tpjfl(jfl)) 209 !# if defined key_mpp_mpi 210 ! IF ( (iafl >= (mig(nldi)-jpizoom+1)) .AND. 211 ! $ (iafl <= (mig(nlei)-jpizoom+1)) .AND. 212 ! $ (ibfl >= (mjg(nldj)-jpjzoom+1)) .AND. 213 ! $ (ibfl <= (mjg(nlej)-jpjzoom+1)) ) THEN 214 !! 215 !! local index 216 !! 217 ! iafloc=iafln-(mig(1)-jpizoom+1)+1 218 ! ibfloc=ibfln-(mjg(1)-jpjzoom+1)+1 219 !! IF (jk == 1 ) THEN 220 !! PRINT *,'<<<>>> ',jfl,narea, iafloc ,ibfloc, iafln, ibfln,adatrj 221 !! ENDIF 222 !# else 223 ! iafloc=iafln 224 ! ibfloc=ibfln 225 !# endif 226 ! ztemp(jfl)=tn(iafloc,ibfloc,jk) 227 ! zsal(jfl)=sn(iaflo!,ibfloc,jk) 228 !# if defined key_mpp_mpi 229 ! ELSE 230 ! ztemp(jfl) = 0. 231 ! zsal(jfl) = 0. 232 ! ENDIF 233 !# endif 234 !! ... next float 235 ! END DO 236 ! IF( lk_mpp ) CALL mpp_sum( ztemp, jpnfl ) 237 ! IF( lk_mpp ) CALL mpp_sum( zsal , jpnfl ) 238 ! 239 ! IF (lwp) THEN 240 ! WRITE(numflo) ztemp, zsal 241 ! ENDIF 242 !! ... next level jk 243 ! END DO 244 !! ... reset nwflo to 0 for ALL processors, if profile has been written 245 !! nwflo = 0 246 ! ENDIF 247 !! 248 ! CALL flush (numflo) 249 !! ... time of dumping floats 250 !! END IF 163 END DO ! loop on float 164 165 !Only proc 0 writes all positions : SUM of positions on all procs 166 IF( lk_mpp ) THEN 167 CALL mpp_sum( zlon, jpnfl ) ! sums over the global domain 168 CALL mpp_sum( zlat, jpnfl ) ! sums over the global domain 169 CALL mpp_sum( zdep, jpnfl ) ! sums over the global domain 170 CALL mpp_sum( ztem, jpnfl ) ! sums over the global domain 171 CALL mpp_sum( zsal, jpnfl ) ! sums over the global domain 172 CALL mpp_sum( zrho, jpnfl ) ! sums over the global domain 251 173 ENDIF 252 253 IF( (MOD(kt,nn_stockfl) == 0) .OR. ( kt == nitend ) ) THEN 254 ! Writing the restart file 255 IF(lwp) THEN 256 WRITE(numout,*) 257 WRITE(numout,*) 'flo_wri : write in restart_float file ' 258 WRITE(numout,*) '~~~~~~~ ' 174 175 176 !-------------------------------------! 177 ! II- WRITE WRITE WRITE WRITE WRITE ! 178 !-------------------------------------! 179 180 !--------------------------! 181 ! II-1 Write in ascii file ! 182 !--------------------------! 183 184 IF( ln_flo_ascii )THEN 185 186 IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN 187 188 !II-1-a Open ascii file 189 !---------------------- 190 IF( kt == nn_it000 ) THEN 191 CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 192 irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) ) 193 WRITE(numflo,*)cexper,no,irecflo,jpnfl,nn_writefl 194 ENDIF 195 196 !II-1-b Write in ascii file 197 !----------------------------- 198 WRITE(numflo,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp) 199 200 201 !II-1-c Close netcdf file 202 !------------------------- 203 IF( kt == nitend ) CLOSE( numflo ) 204 259 205 ENDIF 260 206 261 ! file is opened and closed every time it is used. 262 263 clname = 'restart.float.' 264 ic = 1 265 DO jc = 1, 16 266 IF( cexper(jc:jc) /= ' ' ) ic = jc 267 END DO 268 clname = clname(1:14)//cexper(1:ic) 269 ic = 1 270 DO jc = 1, 48 271 IF( clname(jc:jc) /= ' ' ) ic = jc 272 END DO 273 274 CALL ctl_opn( inum, clname, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 275 REWIND inum 276 ! 277 DO jpn = 1, jpnij 278 iproc(jpn) = 0 279 END DO 280 ! 281 IF(lwp) THEN 282 REWIND(inum) 283 WRITE (inum) tpifl,tpjfl,tpkfl,nisobfl,ngrpfl 284 CLOSE (inum) 207 !----------------------------------------------------- 208 ! II-2 Write in netcdf file 209 !----------------------------------------------------- 210 211 ELSE 212 213 !II-2-a Write with IOM 214 !---------------------- 215 216 #if defined key_iomput 217 CALL iom_put( "traj_lon" , zlon ) 218 CALL iom_put( "traj_lat" , zlat ) 219 CALL iom_put( "traj_dep" , zdep ) 220 CALL iom_put( "traj_temp" , ztem ) 221 CALL iom_put( "traj_salt" , zsal ) 222 CALL iom_put( "traj_dens" , zrho ) 223 CALL iom_put( "traj_group" , REAL(ngrpfl,wp) ) 224 #else 225 226 !II-2-b Write with IOIPSL 227 !------------------------ 228 229 IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN 230 231 232 !II-2-b-1 Open netcdf file 233 !------------------------- 234 IF( kt==nn_it000 )THEN ! Create and open 235 236 CALL dia_nam( clname, nn_writefl, 'trajec_float' ) 237 clname=TRIM(clname)//".nc" 238 239 CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1 /) , numflo ) 240 241 CALL fliodefv( numflo, 'traj_lon' , (/1,2/), v_t=flio_r8, long_name="Longitude" , units="degrees_east" ) 242 CALL fliodefv( numflo, 'traj_lat' , (/1,2/), v_t=flio_r8, long_name="Latitude" , units="degrees_north" ) 243 CALL fliodefv( numflo, 'traj_depth' , (/1,2/), v_t=flio_r8, long_name="Depth" , units="meters" ) 244 CALL fliodefv( numflo, 'time_counter', (/2/) , v_t=flio_r8, long_name="Time axis" & 245 & , units="seconds since start of the run " ) 246 CALL fliodefv( numflo, 'traj_temp' , (/1,2/), v_t=flio_r8, long_name="Temperature" , units="C" ) 247 CALL fliodefv( numflo, 'traj_salt' , (/1,2/), v_t=flio_r8, long_name="Salinity" , units="PSU" ) 248 CALL fliodefv( numflo, 'traj_dens' , (/1,2/), v_t=flio_r8, long_name="Density" , units="kg/m3" ) 249 CALL fliodefv( numflo, 'traj_group' , (/1/) , v_t=flio_r8, long_name="number of the group" , units="no unit" ) 250 251 CALL flioputv( numflo , 'traj_group' , REAL(ngrpfl,wp) ) 252 253 ELSE ! Re-open 254 255 CALL flioopfd( TRIM(clname), numflo , "WRITE" ) 256 257 ENDIF 258 259 !II-2-b-2 Write in netcdf file 260 !------------------------------- 261 irec = INT( (kt-nn_it000+1)/nn_writefl ) +1 262 ztime = ( kt-nn_it000 + 1 ) * rdt 263 264 CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) ) 265 266 DO jfl = 1, jpnfl 267 268 istart = (/jfl,irec/) 269 icfl = INT( tpkfl(jfl) ) ! K-index of the nearest point before 270 271 CALL flioputv( numflo , 'traj_lon' , zlon(jfl) , start=istart ) 272 CALL flioputv( numflo , 'traj_lat' , zlat(jfl) , start=istart ) 273 CALL flioputv( numflo , 'traj_depth' , zdep(jfl) , start=istart ) 274 CALL flioputv( numflo , 'traj_temp' , ztemp(icfl,jfl) , start=istart ) 275 CALL flioputv( numflo , 'traj_salt' , zsal(icfl,jfl) , start=istart ) 276 CALL flioputv( numflo , 'traj_dens' , zrho(icfl,jfl) , start=istart ) 277 278 ENDDO 279 280 !II-2-b-3 Close netcdf file 281 !--------------------------- 282 CALL flioclo( numflo ) 283 285 284 ENDIF 286 ! 287 ! Compute the number of trajectories for each processor 288 ! 289 IF( lk_mpp ) THEN 290 DO jfl = 1, jpnfl 291 IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND. & 292 &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND. & 293 &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND. & 294 &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 295 iproc(narea) = iproc(narea)+1 296 ENDIF 297 END DO 298 CALL mpp_sum( iproc, jpnij ) 299 ! 300 IF(lwp) THEN 301 WRITE(numout,*) 'DATE',adatrj 302 DO jpn = 1, jpnij 303 IF( iproc(jpn) /= 0 ) THEN 304 WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iproc(jpn), 'trajectories.' 305 ENDIF 306 END DO 307 ENDIF 308 ENDIF 309 ENDIF 310 311 IF( kt == nitend ) CLOSE( numflo ) 312 ! 285 286 #endif 287 ENDIF ! netcdf writing 288 313 289 END SUBROUTINE flo_wri 290 314 291 315 292 # else … … 321 298 END SUBROUTINE flo_wri 322 299 #endif 323 324 !!====================================================================== 300 301 !!======================================================================= 325 302 END MODULE flowri -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r3049 r3051 115 115 INTEGER :: numdct_heat = -1 !: logical unit for heat transports output 116 116 INTEGER :: numdct_salt = -1 !: logical unit for salt transports output 117 INTEGER :: numfl = -1 !: logical unit for floats ascii output 117 118 118 119 !!---------------------------------------------------------------------- -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r2715 r3051 19 19 !!-------------------------------------------------------------------- 20 20 USE dom_oce ! ocean space and time domain 21 USE flo_oce ! floats module declarations 21 22 USE lbclnk ! lateal boundary condition / mpp exchanges 22 23 USE iom_def ! iom variables definitions … … 48 49 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 49 50 PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 50 PRIVATE iom_p 2d, iom_p3d51 PRIVATE iom_p1d, iom_p2d, iom_p3d 51 52 #if defined key_iomput 52 53 PRIVATE set_grid … … 63 64 END INTERFACE 64 65 INTERFACE iom_put 65 MODULE PROCEDURE iom_p0d, iom_p 2d, iom_p3d66 MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 66 67 END INTERFACE 67 68 #if defined key_iomput … … 115 116 CALL event__set_vert_axis( "depthv", gdept_0 ) 116 117 CALL event__set_vert_axis( "depthw", gdepw_0 ) 118 #if defined key_floats 119 CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp) ) 120 #endif 117 121 118 122 ! automatic definitions of some of the xml attributs … … 961 965 #endif 962 966 END SUBROUTINE iom_p0d 967 968 SUBROUTINE iom_p1d( cdname, pfield1d ) 969 CHARACTER(LEN=*) , INTENT(in) :: cdname 970 REAL(wp), DIMENSION(:), INTENT(in) :: pfield1d 971 INTEGER :: jpz 972 #if defined key_iomput 973 jpz=SIZE(pfield1d) 974 CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpz/) ) ) 975 #else 976 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings 977 #endif 978 END SUBROUTINE iom_p1d 963 979 964 980 SUBROUTINE iom_p2d( cdname, pfield2d ) -
branches/2011/dev_MERCATOR_2011_MERGE/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3049 r3051 342 342 #endif 343 343 ! ! Diagnostics 344 IF( lk_floats ) CALL flo_init ! drifting Floats 344 345 CALL iom_init ! iom_put initialization 345 IF( lk_floats ) CALL flo_init ! drifting Floats346 346 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag 347 347 CALL dia_ptr_init ! Poleward TRansports initialization
Note: See TracChangeset
for help on using the changeset viewer.