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 2860 for branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src – NEMO

Ignore:
Timestamp:
2011-09-26T12:21:02+02:00 (13 years ago)
Author:
cbricaud
Message:

correction of array bounds

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90

    r2858 r2860  
    5050        nb_inmesh        ,     & ! number of intersection between section and the mesh 
    5151        nmesh                    ! number of cells in processor domain 
     52     INTEGER :: itest , jtest    ! dummy integer 
    5253     REAL(wp),SAVE :: zdistmesh      ! Taller cell of the mesh in ocean 
    5354     REAL(wp)      :: & 
     
    333334     CALL write_debug(jsec,"extremities of section in the grid : ") 
    334335     ji=sec%listPoint(1)%I ; jj=sec%listPoint(1)%J 
    335      WRITE(cltmp,'(A15,X,i4.4,X,i4.4,X,f8.3,X,f8.3)')'First point: ',sec%listPoint(1),glamf(ji,jj),gphif(ji,jj)  
    336      CALL write_debug(jsec,cltmp) 
    337      ji=endingPoint%I ; jj=endingPoint%J 
    338      WRITE(cltmp,'(A15,X,i4.4,X,i4.4,X,f8.3,X,f8.3)')'Last  point: ',endingPoint,glamf(ji,jj),gphif(ji,jj) 
    339      CALL write_debug(jsec,cltmp) 
    340      ! 
    341      coord_a=pointToCoordF(sec%listPoint(1)) ; coord_b=pointToCoordF(endingPoint) 
    342      ll_test = .FALSE. 
    343      IF( ll_date_domain .AND. ABS( coord_a%lon - coord_b%lon ).GT. 180) ll_test= .TRUE. 
    344      zdistante=distance2(coord_a,coord_b ,ll_test ) 
    345      WRITE(cltmp,'(A20,f10.3)' )'distance between IJ-extremities : ',zdistante 
    346      CALL write_debug(jsec,cltmp) 
    347      ! 
    348      CALL write_debug(jsec,"Initial extremities : ")  
    349      WRITE(cltmp,'( 2(f9.3),A3,2(f9.3) )')coordFirst,'---',coordLast 
    350      CALL write_debug(jsec,cltmp) 
    351      ll_test = .FALSE. 
    352      IF( ll_date_domain .AND. ABS(coordFirst%lon - coordLast%lon).GT. 180)ll_test= .TRUE. 
    353      zdistante=distance2(coordFirst,coordLast,ll_test) 
    354      WRITE(cltmp,'(A30,f10.3)')' distance between initial extremities : ',zdistante 
    355      CALL write_debug(jsec,cltmp) 
    356      CALL write_debug(jsec,"                  ") 
     336     IF( sec%nb_point .ne. 0 )THEN 
     337        ji=sec%listPoint(1)%I ; jj=sec%listPoint(1)%J 
     338        WRITE(cltmp,'(A15,X,i4.4,X,i4.4,X,f8.3,X,f8.3)')'First point: ',sec%listPoint(1),glamf(ji,jj),gphif(ji,jj)  
     339        CALL write_debug(jsec,cltmp) 
     340        ji=endingPoint%I ; jj=endingPoint%J 
     341        WRITE(cltmp,'(A15,X,i4.4,X,i4.4,X,f8.3,X,f8.3)')'Last  point: ',endingPoint,glamf(ji,jj),gphif(ji,jj) 
     342        CALL write_debug(jsec,cltmp) 
     343        ! 
     344        coord_a=pointToCoordF(sec%listPoint(1)) ; coord_b=pointToCoordF(endingPoint) 
     345        ll_test = .FALSE. 
     346        IF ( ll_date_domain .AND. ABS( coord_a%lon - coord_b%lon ).GT. 180) ll_test= .TRUE. 
     347        zdistante=distance2(coord_a,coord_b ,ll_test ) 
     348        WRITE(cltmp,'(A20,f10.3)' )'distance between IJ-extremities : ',zdistante 
     349        CALL write_debug(jsec,cltmp) 
     350        ! 
     351        CALL write_debug(jsec,"Initial extremities : ")  
     352        WRITE(cltmp,'( 2(f9.3),A3,2(f9.3) )')coordFirst,'---',coordLast 
     353        CALL write_debug(jsec,cltmp) 
     354        ll_test = .FALSE. 
     355        IF( ll_date_domain .AND. ABS(coordFirst%lon - coordLast%lon).GT. 180)ll_test= .TRUE. 
     356        zdistante=distance2(coordFirst,coordLast,ll_test) 
     357        WRITE(cltmp,'(A30,f10.3)')' distance between initial extremities : ',zdistante 
     358        CALL write_debug(jsec,cltmp) 
     359        CALL write_debug(jsec,"                  ") 
     360     ELSE 
     361        WRITE(cltmp,'(A50)' )"no intersection between section and mesh" 
     362     ENDIF 
    357363 
    358364     !==========================================================! 
     
    361367     CALL write_debug(jsec,"Find the serie of mesh's points that form the section") 
    362368 
    363      IF( nb_inmesh .NE. 0 )THEN 
     369     IF( sec%nb_point .ne. 0 )THEN 
     370     !IF( nb_inmesh .NE. 0 )THEN 
    364371 
    365372        !The serie of mesh's points that form the section will 'link'  
     
    406413           CALL write_debug(jsec,cltmp) 
    407414           CALL write_debug(jsec,"E/W/N/S points") 
    408            WRITE(cltmp,101)glamf(  EstPoint%I,EstPoint%J)  ,gphif(  EstPoint%I,  EstPoint%J), & 
    409                            glamf( WestPoint%I,WestPoint%J) ,gphif( WestPoint%I, WestPoint%J), & 
    410                            glamf(NorthPoint%I,NorthPoint%J),gphif(NorthPoint%I,NorthPoint%J) ,& 
    411                            glamf(SouthPoint%I,SouthPoint%J),gphif(SouthPoint%I,SouthPoint%J) 
    412            CALL write_debug(jsec,cltmp) 
    413415           WRITE(cltmp,102)EstPoint,WestPoint,NorthPoint,SouthPoint 
    414416           CALL write_debug(jsec,cltmp) 
    415  
     417           itest=MIN(MAX(EstPoint%I,0),jpi+1) ; jtest=MIN(MAX(EstPoint%J,0),jpj+1) 
     418           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN  
     419              WRITE(cltmp,101)'Est',glamf(itest,jtest),gphif(itest,jtest) 
     420              CALL write_debug(jsec,cltmp) 
     421           ELSE 
     422              CALL write_debug(jsec,"Est point out of domain") 
     423           ENDIF 
     424           ! 
     425           itest=MIN(MAX(WestPoint%I,0),jpi+1) ; jtest=MIN(MAX(WestPoint%J,0),jpj+1) 
     426           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN  
     427              WRITE(cltmp,101)'West',glamf(itest,jtest),gphif(itest,jtest) 
     428              CALL write_debug(jsec,cltmp) 
     429           ELSE 
     430              CALL write_debug(jsec,"West point out of domain") 
     431           ENDIF 
     432           ! 
     433           itest=MIN(MAX(NorthPoint%I,0),jpi+1) ; jtest=MIN(MAX(NorthPoint%J,0),jpj+1) 
     434           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN  
     435              WRITE(cltmp,101)'North',glamf(itest,jtest),gphif(itest,jtest) 
     436              CALL write_debug(jsec,cltmp) 
     437           ELSE 
     438              CALL write_debug(jsec,"North point out of domain") 
     439           ENDIF 
     440           ! 
     441           itest=MIN(MAX(SouthPoint%I,0),jpi+1) ; jtest=MIN(MAX(SouthPoint%J,0),jpj+1) 
     442           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN  
     443              WRITE(cltmp,101)'South',glamf(itest,jtest),gphif(itest,jtest) 
     444              CALL write_debug(jsec,cltmp) 
     445           ELSE 
     446              CALL write_debug(jsec,"South point out of domain") 
     447           ENDIF 
     448           ! 
     449           ! 
    416450100 FORMAT ( A15,2(i4.4," "),2(f7.3," ") ) 
    417 101 FORMAT ( "E ",2(f7.3," "),"W ",2(f7.3," "),"N ",2(f7.3," "),"S ",2(f7.3," ")) 
     451101 FORMAT ( A6,2(f7.3," ")) 
    418452102 FORMAT ( "E ",i4.4,' ',i4.4,"//W ",i4.4,' ',i4.4,"//N ",i4.4,' ',i4.4,"//S ",i4.4,' ',i4.4 ) 
    419453 
     
    657691 
    658692     !debug      
    659      CALL write_debug(jsec,"-------------------------------------") 
    660      CALL write_debug(jsec,"list of points in the grid : ") 
    661      DO jseg=1,sec%nb_point  
    662         ji=sec%listPoint(jseg)%I ; jj=sec%listPoint(jseg)%J 
    663         WRITE(cltmp, '(i4.4,X,i4.4,X,i4.4,X,f8.3,X,f8.3)' )jseg,ji,jj,glamf(ji,jj),gphif(ji,jj) 
    664         CALL write_debug(jsec,cltmp) 
    665      ENDDO 
     693     IF( sec%nb_point .ne. 0 )THEN 
     694        CALL write_debug(jsec,"-------------------------------------") 
     695        CALL write_debug(jsec,"list of points in the grid : ") 
     696        DO jseg=1,sec%nb_point  
     697           ji=sec%listPoint(jseg)%I ; jj=sec%listPoint(jseg)%J 
     698           WRITE(cltmp, '(i4.4,X,i4.4,X,i4.4,X,f8.3,X,f8.3)' )jseg,ji,jj,glamf(ji,jj),gphif(ji,jj) 
     699           CALL write_debug(jsec,cltmp) 
     700        ENDDO 
    666701     
    667      !test if we are one end-point 
    668      IF( sec%listPoint(sec%nb_point)%I .NE. endingPoint%J .AND. sec%listPoint(sec%nb_point)%J .NE. endingPoint%J )THEN    
    669         PRINT*,TRIM(sec%name)," NOT ARRIVED TO endingPoint FOR jsec =  ",jsec 
     702        !test if we are one end-point 
     703        IF( sec%listPoint(sec%nb_point)%I .NE. endingPoint%J .AND. sec%listPoint(sec%nb_point)%J .NE. endingPoint%J )THEN    
     704           PRINT*,TRIM(sec%name)," NOT ARRIVED TO endingPoint FOR jsec =  ",jsec 
     705        ENDIF 
    670706     ENDIF 
    671707 
    672708     !now compute new slopeSection with ij-coordinates of first and last point  
    673      IF (  sec%listPoint(sec%nb_point)%I .NE.  sec%listPoint(1)%I ) THEN 
    674         sec%slopeSection = ( sec%listPoint(sec%nb_point)%J - sec%listPoint(1)%J ) /  & 
    675                            ( sec%listPoint(sec%nb_point)%I - sec%listPoint(1)%I )       
    676      ELSE 
    677         sec%slopeSection = 10000._wp 
     709     IF( sec%nb_point .ne. 0 )THEN 
     710        IF (  sec%listPoint(sec%nb_point)%I .NE.  sec%listPoint(1)%I ) THEN 
     711           sec%slopeSection = ( sec%listPoint(sec%nb_point)%J - sec%listPoint(1)%J ) /  & 
     712                              ( sec%listPoint(sec%nb_point)%I - sec%listPoint(1)%I )       
     713        ELSE 
     714           sec%slopeSection = 10000._wp 
     715        ENDIF 
    678716     ENDIF 
    679717  
Note: See TracChangeset for help on using the changeset viewer.