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.
Changeset 2947 – NEMO

Changeset 2947


Ignore:
Timestamp:
2011-10-17T17:36:04+02:00 (12 years ago)
Author:
rfurner
Message:

small changes to comments

Location:
branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/job.ksh

    r2943 r2947  
    1111##################################################### 
    1212# each configuration is defined by: 
    13 #   - INSPACE: directory where is the coordinate 
    14 #   - COOR_FIL: configuration's coordinate 
    15 #   - LIST:     configuration's list of section 
     13#   - INSPACE: directory the coordinate netcdf file is 
     14#   - COOR_FIL: configuration's coordinate netcdf file 
     15#   - LIST:     configuration's list of sections 
    1616# 
    1717##################################################### 
  • branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90

    r2879 r2947  
    22   !!===================================================================== 
    33   !!                       ***  MODULE  diadct  *** 
    4    !! Ocean diagnostics: Compute the transport trough a section 
     4   !! Ocean diagnostics: Compute the transport through a section 
    55   !! 
    66   !! History: 2011: Clement Bricaud, Mercator-Ocean 
     
    2525     !!                     ***  ROUTINE compsec  *** 
    2626     !! 
    27      !!  ** Purpose : Compute the serie of mesh's points that represents the section 
     27     !!  ** Purpose : Compute the series of mesh points that represent the section 
    2828     !!               defined by its extremities. 
    2929     !! 
    3030     !!  ** Method  :  
    31      !!          I.   Found which cells of the mesh the section is crossing 
     31     !!          I.   Find which cells of the mesh the section is crossing 
    3232     !!          II.  Classification of the intersections mesh/section 
    33      !!                  -first classification west to east           
     33     !!                  -first  classification west to east           
    3434     !!                  -second classification south to north  
    3535     !!          III. Find extremities of section in the mesh 
    36      !!          IV.  Find the serie of mesh's points that form the section 
     36     !!          IV.  Find the series of mesh points that form the section 
    3737     !!  ** Input: sec : the section to compute 
    3838     !! 
     
    4040     !!--------------------------------------------------------------------- 
    4141     !! * Arguments 
    42      INTEGER,INTENT(IN)           :: jsec  !number of the section 
    43      TYPE(SECTION), INTENT(INOUT) :: sec   !information about the section 
    44      LOGICAL ,INTENT(IN)          :: lkdebug !debug or not debug this section 
     42     INTEGER,INTENT(IN)           :: jsec    ! number of the section 
     43     TYPE(SECTION), INTENT(INOUT) :: sec     ! information about the section 
     44     LOGICAL ,INTENT(IN)          :: lkdebug ! debug or not debug this section 
    4545 
    4646     !! * Local variables 
    4747     INTEGER :: & 
    4848        ji,jj            ,     & ! dummy loop argument 
    49         jseg             ,     & ! loop on segments taht form the section     
    50         nb_inmesh        ,     & ! number of intersection between section and the mesh 
     49        jseg             ,     & ! loop on segments that form the section     
     50        nb_inmesh        ,     & ! number of intersections between the section and the mesh 
    5151        nmesh                    ! number of cells in processor domain 
    5252     INTEGER :: itest , jtest    ! dummy integer 
    53      REAL(wp),SAVE :: zdistmesh      ! Taller cell of the mesh in ocean 
     53     REAL(wp),SAVE :: zdistmesh  ! Taller cell of the mesh in ocean 
    5454     REAL(wp)      :: & 
    5555        zdistEst   , zdistNorth , zdistWest , zdistSouth ,  &! temporary scalars 
    5656        zdistEst2  , zdistNorth2, zdistWest2, zdistSouth2,  &! temporary scalars 
    5757        zdistEst3  , zdistNorth3, zdistWest3, zdistSouth3,  &! temporary scalars 
    58         zdistFirst , zdistLast  , zdistref  ,               &!         " 
    59         zdistante  , zdistante2 , zdistnew  , zdistnew2  ,  &!         " 
    60         zdeltai    , zdeltaj                                !         " 
     58        zdistFirst , zdistLast  , zdistref  ,               &! temporary scalars 
     59        zdistante  , zdistante2 , zdistnew  , zdistnew2  ,  &! temporary scalars 
     60        zdeltai    , zdeltaj                                 ! temporary scalars 
    6161     LOGICAL :: &  
    6262        ll_overlap_sec_left = .FALSE. , ll_overlap_sec_right = .FALSE. ,&! temporary logical 
    63         ll_date_domain_left = .FALSE. , ll_date_domain_right = .FALSE. ,&!       " 
    64         ll_overlap_sec      = .FALSE. , ll_date_domain       = .FALSE. ,&!       " 
    65         ll_test             = .FALSE.                                    !       " 
     63        ll_date_domain_left = .FALSE. , ll_date_domain_right = .FALSE. ,&! temporary logical 
     64        ll_overlap_sec      = .FALSE. , ll_date_domain       = .FALSE. ,&! temporary logical 
     65        ll_test             = .FALSE.                                    ! temporary logical 
    6666     LOGICAL :: lest, lwest, lnorth, lsouth 
    6767     LOGICAL :: l_oldmethod 
     
    9191      
    9292     nmesh       = jpi*jpj          ! number of cells in processor domain 
    93      nb_inmesh   = 0                !initialize number of intersection between section and the mesh 
     93     nb_inmesh   = 0                ! initialize number of intersections between section and the mesh 
    9494     zdistEst  =0. ; zdistNorth=0. ; zdistWest=0. ; zdistSouth=0.   ! temporary scalars 
    95      zdistFirst=0. ; zdistLast =0.                                   !         " 
    96      zdistante =0. ; zdistante2=0. ; zdistnew=0.  ; zdistnew2=0.    !         " 
     95     zdistFirst=0. ; zdistLast =0.                                  ! temporary scalars 
     96     zdistante =0. ; zdistante2=0. ; zdistnew=0.  ; zdistnew2=0.    ! temporary scalars 
    9797     zdeltai=0.    ; zdeltaj=0.  
    9898     coord_a     = COORD_SECTION( 0., 0. ) ; coord_b    = COORD_SECTION( 0., 0. ) 
     
    106106 
    107107     IF( jsec == 1 )THEN 
    108         !Found the taller cell of the mesh in ocean (used in compsec) 
     108        !Find the taller cell of the mesh in ocean (used in compsec) 
    109109        zdistmesh=0. 
    110110        DO jj=2,jpj 
     
    124124 
    125125     !===========================================================!     
    126      !I. Found which cells of the mesh the section is  crossing  ! 
     126     !I. Find which cells of the mesh the section is  crossing  ! 
    127127     !===========================================================! 
    128128 
     
    363363 
    364364     !==========================================================! 
    365      ! IV. Find the serie of mesh's points that form the section! 
     365     ! IV. Find the series of mesh points that form the section ! 
    366366     !==========================================================! 
    367367     CALL write_debug(jsec,"Find the serie of mesh's points that form the section") 
     
    369369     IF( sec%nb_point .ne. 0 )THEN 
    370370 
    371         !The serie of mesh's points that form the section will 'link'  
     371        !The series of mesh points that form the section will 'link'  
    372372        !sec%listPoint(1) to endingPoint: it will be stored in  
    373373        !sec%listPoint(jseg) 
    374374        ! 
    375         !We take place on the fist point (sec%listPoint(1))  
     375        !We take place on the first point (sec%listPoint(1))  
    376376        ! a.  We find the 4 adjacent points (North, South, East, West) 
    377377        ! b.  Compute distance between current point and endingPoint 
     
    452452 
    453453                
    454            !we  are on end-point 
     454           !Either we are at an end-point 
    455455           !-------------------- 
    456456           IF(      SouthPoint%I==endingPoint%I .AND. SouthPoint%J==endingPoint%J )THEN  
     
    464464 
    465465           ELSE 
    466            !we are NOT on end-point 
     466           !Else we are NOT on end-point 
    467467           !------------------------ 
    468468 
     
    473473              ! c. compute distance between the 4 adjacent points and endingPoint 
    474474              !------------------------------------------------------------------ 
    475               ! BE CARREFUL! When the domain crosses the date line (ll_date_domain): 
     475              ! BE CAREFUL! When the domain crosses the date line (ll_date_domain): 
    476476              ! When we will compute distances between W/E/S/N points and endingPoint, 
    477477              ! we have to check if theses 4 lines crosses the date line 
    478478              ! (test: ABS(coordTemp%lon - coordLast%lon).GT. 180) 
    479479              ! If it's true,we have to add 360° to coordLast%long to compute the  
    480               ! good distance through the date line and not through the complementary 
     480              ! correct distance through the date line and not through the complementary 
    481481              ! in the mesh. 
    482482        
     
    497497              IF( sec%listPoint(jseg)%I .EQ. jpi )THEN 
    498498                 !We test if the current point is on the east side of the mesh 
    499                  ! The method is done such as we go toward east to link 
     499                 ! The method is done such that we go toward east to link 
    500500                 ! sec%listPoint(1) to endingPoint. 
    501501                 ! So, if the section crosses the overlapping band (ll_overlap_sec=T), 
     
    505505                 IF( ll_overlap_sec  )THEN 
    506506                    !section crosses the overlapping band  
    507                     !So EstPoint is on the west side of the mesh 
     507                    !So EastPoint is on the west side of the mesh 
    508508                    EstPoint = POINT_SECTION(3,sec%listPoint(jseg)%J) 
    509509                    zdistEst2= distance2(pointToCoordF(EstPoint)  ,coordLast ,.FALSE.) 
     
    592592                 CALL write_debug(jsec,cltmp) 
    593593                    
    594                  !be carreful! we can't go backward. 
     594                 !be careful! we can't go backward. 
    595595                 zdistNorth = zdistNorth2    ; zdistSouth = zdistSouth2 
    596596                 zdistEst   = zdistEst2      ; zdistWest  = zdistWest2  
     
    677677 
    678678 
    679      ELSE ! nb_inmesh == 0 
     679     ELSE ! isec%nb_point == 0 
    680680        DO jseg=1,nb_point_max  
    681681           sec%listPoint(:)=POINT_SECTION(0,0) 
     
    695695        ENDDO 
    696696     
    697         !test if we are one end-point 
     697        !test if we are an end-point 
    698698        IF( sec%listPoint(sec%nb_point)%I .NE. endingPoint%J .AND. sec%listPoint(sec%nb_point)%J .NE. endingPoint%J )THEN    
    699699           PRINT*,TRIM(sec%name)," NOT ARRIVED TO endingPoint FOR jsec =  ",jsec 
  • branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/declarations.f90

    r2878 r2947  
    1414  INTEGER, PUBLIC, PARAMETER   :: nb_class_max  = 10            ! Max number of classes 
    1515  INTEGER, PUBLIC, PARAMETER   :: nb_sec_max    = 150           ! Max number of sections 
    16   INTEGER, PUBLIC, PARAMETER   :: nb_point_max  = 2000          ! Max number of segment per section 
     16  INTEGER, PUBLIC, PARAMETER   :: nb_point_max  = 2000          ! Max number of segments per section 
    1717  INTEGER, PUBLIC, PARAMETER   :: nb_type_class = 14            ! Max number of types of classes 
    1818  INTEGER, PUBLIC, PARAMETER   :: numnam=3                      ! Unit for namelist 
     
    2121 
    2222  INTEGER, PUBLIC              :: jpi,jpj                       ! domain dimensions 
    23   INTEGER, PUBLIC              :: nb_sec                        ! Number of section read in input file 
     23  INTEGER, PUBLIC              :: nb_sec                        ! Number of sections read from input file 
    2424  INTEGER, PUBLIC              :: nsecdebug = 0                 ! Number of the section to debug 
    2525 
     
    3737  TYPE SECTION 
    3838     CHARACTER(len=60)                              :: name                ! name of the sec 
    39      LOGICAL                                        :: llstrpond           ! true if you want the computation of salinity and 
    40                                                                            ! temperature balanced by the transport 
    41      LOGICAL                                        :: ll_ice_section      ! icesurf and icevol computation 
     39     LOGICAL                                        :: llstrpond           ! true if you want the computation of salt  
     40                                                                           ! and heat transport 
     41     LOGICAL                                        :: ll_ice_section      ! ice surface and icevolume transport computation 
    4242     LOGICAL                                        :: ll_date_line        ! = T if the section crosses the date-line 
    43      TYPE(COORD_SECTION), DIMENSION(2)              :: coordSec            ! longitude and latitude of the extremities of the sec 
     43     TYPE(COORD_SECTION), DIMENSION(2)              :: coordSec            ! longitude and latitude of the extremities of the section 
    4444     INTEGER                                        :: nb_class            ! number of boundaries for density classes 
    4545     INTEGER, DIMENSION(nb_point_max)               :: direction           ! vector direction of the point in the section 
    46      CHARACTER(len=40),DIMENSION(nb_class_max)      :: classname           ! caracteristics of the class 
     46     CHARACTER(len=40),DIMENSION(nb_class_max)      :: classname           ! characteristics of the class 
    4747     REAL(wp), DIMENSION(nb_class_max)              :: zsigi             ,&! insitu density classes    (99 if you don't want) 
    4848                                                       zsigp             ,&! potential density classes    (99 if you don't want) 
    4949                                                       zsal              ,&! salinity classes   (99 if you don't want) 
    5050                                                       ztem              ,&! temperature classes(99 if you don't want) 
    51                                                        zlay                ! level classes      (99 if you don't want) 
    52      REAL(wp)                                       :: slopeSection        ! coeff directeur de la section 
    53      INTEGER                                        :: nb_point            ! section's number of point 
    54      TYPE(POINT_SECTION),DIMENSION(nb_point_max)    :: listPoint           ! list of point in the section 
     51                                                       zlay                ! depth level classes      (99 if you don't want) 
     52     REAL(wp)                                       :: slopeSection        ! slope of the section  
     53     INTEGER                                        :: nb_point            ! number of points in the section 
     54     TYPE(POINT_SECTION),DIMENSION(nb_point_max)    :: listPoint           ! list of points in the section 
    5555  END TYPE SECTION 
    5656 
  • branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90

    r2878 r2947  
    2424     CHARACTER(LEN=80)  :: cdum 
    2525     INTEGER            :: jsec ,&! loop on sections 
    26                            jseg   ! loop on sections' points 
     26                           jseg   ! loop on segments (parts of the section) 
    2727     CHARACTER(len=40)  :: clname 
    2828     LOGICAL            :: llok 
     
    8787     !----------------------! 
    8888     DO jsec=1,nb_sec 
    89           !we use compsec to generate the serie of grid points making the section 
     89          !we use compsec to generate the series of grid points making the section 
    9090          IF(jsec == nsecdebug .OR. nsecdebug ==-1)THEN 
    9191             CALL compsec(jsec,secs(jsec),.true.) 
  • branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90

    r2878 r2947  
    2121  !!              ***  ROUTINE coord_mesh_read  *** 
    2222  !! 
    23   !! ** Purpose :   Read a coordinate and a meshmask file in NetCDF format  
     23  !! ** Purpose :   Read a coordinate file and a meshmask file in NetCDF format  
    2424  !! 
    2525  !!---------------------------------------------------------------------       
     
    5757  !!              ***  ROUTINE getdim  *** 
    5858  !! 
    59   !! ** Purpose :   get dimsensions of a netcdf file 
     59  !! ** Purpose :   get dimensions of a netcdf file 
    6060  !! 
    6161  !!---------------------------------------------------------------------- 
     
    6868  INTEGER           :: istatus, id_var      ! dummy variable 
    6969  CHARACTER(len=30) :: clname               ! dimension name    
    70   INTEGER, ALLOCATABLE,DIMENSION(:) :: ndim ! dimensions value 
     70  INTEGER, ALLOCATABLE,DIMENSION(:) :: ndim ! dimension value 
    7171  !!---------------------------------------------------------------------- 
    7272 
  • branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90

    r2878 r2947  
    2323     !! 
    2424     !! ** Purpose: read ascii file 'list_sections.ascii' that contains 
    25      !!             sections description 
     25     !!             section descriptions 
    2626     !! 
    2727     !!--------------------------------------------------------------------- 
     
    2929 
    3030     !! * Local declarations 
    31      INTEGER             :: jsec !loop on sections number 
     31     INTEGER             :: jsec !loop on section number 
    3232     INTEGER             :: iost,ji 
    3333     INTEGER             :: iclass , jclass 
     
    4848     PRINT*,'               ' 
    4949 
    50      nb_sec=0 !initialize numer of sections read in list_sections.ascii 
     50     nb_sec=0 !initialize number of sections read in list_sections.ascii 
    5151 
    5252     !open and read input file 
     
    7575                 ENDDO 
    7676 
    77                  !computation of salinity and temperature balanced by the transport ? 
     77                 !computation of heat and salt transport ? 
    7878                 llstrpond=.FALSE. ; IF( cdstrpond .EQ. 'okstrpond' ) llstrpond=.TRUE. 
    7979 
     
    8181                 llice=.FALSE. ; IF( cdice .EQ. 'okice' ) llice=.TRUE. 
    8282 
    83                  !store extremities coordinates 
     83                 !store coordinates of the extremities 
    8484                 coord_point1=COORD_SECTION(plon1,plat1) 
    8585                 coord_point2=COORD_SECTION(plon2,plat2) 
    8686                 coord_sec=(/coord_point1,coord_point2/) 
    8787 
    88                  !Extremities of the sec are classed 
     88                 !Extremities of the section are classed 
    8989                 lldate=.FALSE. 
    9090                 IF(  coord_sec(2)%lon .LT. coord_sec(1)%lon  .OR.   & 
     
    102102                 ENDIF 
    103103 
    104                  !slope of the sec (equidistant cylindric projection) 
     104                 !slope of the section (equidistant cylindric projection) 
    105105                 zslope=slope_coeff(coord_sec(1),coord_sec(2),lldate) 
    106106 
    107                  !!init global array secs 
     107                 !!initialise global array secs 
    108108                 secs(jsec)%llstrpond=.FALSE.   
    109109                 secs(jsec)%ll_date_line=.FALSE. ; secs(jsec)%nb_class=0 
     
    113113                 secs(jsec)%nb_point=0 
    114114 
    115                  !store all informations in global array secs 
     115                 !store all information in global array secs 
    116116                 secs(jsec)%name           = cdsecname 
    117117                 secs(jsec)%llstrpond      = llstrpond 
     
    121121                 secs(jsec)%ll_date_line   = lldate 
    122122 
    123                  !debug informations 
     123                 !debug information 
    124124                 CALL write_debug(jsec,'Informations read in ascii file:') 
    125125                 CALL write_debug(jsec,'--------------------------------') 
  • branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/sections_tools.f90

    r2878 r2947  
    8383     !! 
    8484     !!              B                   A first point of the section 
    85      !!             / \                  B intermediar point on the section 
     85     !!             / \                  B intermediate point on the section 
    8686     !!            / | \                 C last point of the section 
    8787     !!           /  |  \                
     
    217217     ! Compute coefficient b for a straight line y=a*x+b 
    218218     !        Usual method:  knowing value of a, we compute b with coordinates of 1 point: 
    219      !                       b=latA-a.lonA ou bien b=latB-a.lonB 
     219     !                       b=latA-a.lonA or b=latB-a.lonB 
    220220     !        Particular case: the straight line crosses the date line; so it is in 2 parts: 
    221221     !                         one on the left of the date-line and one the right 
     
    318318          !  and in [sec%coordSec(1),sec%coordSec(2)]    ! 
    319319          !==============================================! 
    320           !Be carreful! The test is not the same for all configurations 
     320          !Be careful! The test is not the same for all configurations 
    321321          IF( sec%ll_date_line )THEN 
    322322 
     
    398398     REAL(wp), PARAMETER                :: fm=7875.,fa=211.,fc=1663.,fmi=1./fm 
    399399     INTEGER                            :: il, ir, i, iq, ist    !local integers 
    400      INTEGER                            :: jj                    !loop indice 
     400     INTEGER                            :: jj                    !loop indices 
    401401     REAL(wp)                           :: zfx, za, zb           !local real 
    402402     INTEGER,DIMENSION(nstack)          :: istack(nstack)        !temp array 
     
    515515               PRINT*,"Can not open TRIM(clfilename)." ; STOP 
    516516           ENDIF    
    517         !ELSE 
    518         !   PRINT*,TRIM(clfilename)//" already opened"   
    519517        ENDIF 
    520518       
    521        !write 
    522519       WRITE(iunit,*)TRIM(cd_write) 
    523520 
  • branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/writesections.f90

    r2878 r2947  
    4141     LOGICAL             :: llok   ! 
    4242     CHARACTER(len=40)   :: clname ! 
    43      TYPE(POINT_SECTION) :: point  !a point's coordinates  
     43     TYPE(POINT_SECTION) :: point  !coordinates of a point 
    4444 
    4545     !!--------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.