Changeset 2860
- Timestamp:
- 2011-09-26T12:21:02+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2802_MERCATOR10_diadct/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90
r2858 r2860 50 50 nb_inmesh , & ! number of intersection between section and the mesh 51 51 nmesh ! number of cells in processor domain 52 INTEGER :: itest , jtest ! dummy integer 52 53 REAL(wp),SAVE :: zdistmesh ! Taller cell of the mesh in ocean 53 54 REAL(wp) :: & … … 333 334 CALL write_debug(jsec,"extremities of section in the grid : ") 334 335 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 357 363 358 364 !==========================================================! … … 361 367 CALL write_debug(jsec,"Find the serie of mesh's points that form the section") 362 368 363 IF( nb_inmesh .NE. 0 )THEN 369 IF( sec%nb_point .ne. 0 )THEN 370 !IF( nb_inmesh .NE. 0 )THEN 364 371 365 372 !The serie of mesh's points that form the section will 'link' … … 406 413 CALL write_debug(jsec,cltmp) 407 414 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)413 415 WRITE(cltmp,102)EstPoint,WestPoint,NorthPoint,SouthPoint 414 416 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 ! 416 450 100 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," "))451 101 FORMAT ( A6,2(f7.3," ")) 418 452 102 FORMAT ( "E ",i4.4,' ',i4.4,"//W ",i4.4,' ',i4.4,"//N ",i4.4,' ',i4.4,"//S ",i4.4,' ',i4.4 ) 419 453 … … 657 691 658 692 !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 666 701 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 670 706 ENDIF 671 707 672 708 !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 678 716 ENDIF 679 717
Note: See TracChangeset
for help on using the changeset viewer.