Changeset 1884 for branches/TAM_V3_0/NEMO/OPA_SRC/geo2ocean.F90
- Timestamp:
- 2010-05-27T11:26:52+02:00 (14 years ago)
- File:
-
- 1 edited
-
branches/TAM_V3_0/NEMO/OPA_SRC/geo2ocean.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/TAM_V3_0/NEMO/OPA_SRC/geo2ocean.F90
r1152 r1884 3 3 !! *** MODULE geo2ocean *** 4 4 !! Ocean mesh : ??? 5 !!===================================================================== 5 !!====================================================================== 6 !! History : OPA ! 07-1996 (O. Marti) Original code 7 !! NEMO 1.0 ! 02-2008 (G. Madec) F90: Free form 8 !! 3.0 ! 9 !!---------------------------------------------------------------------- 6 10 7 11 !!---------------------------------------------------------------------- … … 11 15 !! repere : old routine suppress it ??? 12 16 !!---------------------------------------------------------------------- 13 !! * Modules used14 17 USE dom_oce ! mesh and scale factors 15 18 USE phycst ! physical constants … … 18 21 19 22 IMPLICIT NONE 20 21 !! * Accessibility22 23 PRIVATE 23 PUBLIC rot_rep, repcmo, repere, geo2oce ! only rot_rep should be used 24 25 PUBLIC rot_rep, repcmo, repere, geo2oce, oce2geo ! only rot_rep should be used 24 26 ! repcmo and repere are keep only for compatibility. 25 27 ! they are only a useless overlay of rot_rep 26 27 !! * Module variables 28 PUBLIC obs_rot 29 28 30 REAL(wp), DIMENSION(jpi,jpj) :: & 29 31 gsint, gcost, & ! cos/sin between model grid lines and NP direction at T point … … 34 36 LOGICAL :: lmust_init = .TRUE. !: used to initialize the cos/sin variables (se above) 35 37 36 !! * Substitutions38 !! * Substitutions 37 39 # include "vectopt_loop_substitute.h90" 38 !!---------------------------------------------------------------------- -----------39 !! OPA 9.0 , LOCEAN-IPSL (2005)40 !! $Id$ 41 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt42 !!---------------------------------------------------------------------- -----------40 !!---------------------------------------------------------------------- 41 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 42 !! $Id$ 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 44 !!---------------------------------------------------------------------- 43 45 44 46 CONTAINS … … 54 56 !! ** Method : Initialization of arrays at the first call. 55 57 !! 56 !! ** Action : - px2 : first componante (defined at u point)58 !! ** Action : - px2 : first componante (defined at u point) 57 59 !! - py2 : second componante (defined at v point) 58 !! 59 !! History : 60 !! 7.0 ! 07-96 (O. Marti) Original code 61 !! 8.5 ! 02-08 (G. Madec) F90: Free form 62 !!---------------------------------------------------------------------- 63 !! * Arguments 64 REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) :: & 65 pxu1, pyu1, & ! geographic vector componantes at u-point 66 pxv1, pyv1 ! geographic vector componantes at v-point 67 REAL(wp), INTENT( out ), DIMENSION(jpi,jpj) :: & 68 px2, & ! i-componante (defined at u-point) 69 py2 ! j-componante (defined at v-point) 60 !!---------------------------------------------------------------------- 61 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pxu1, pyu1 ! geographic vector componantes at u-point 62 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pxv1, pyv1 ! geographic vector componantes at v-point 63 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: px2 ! i-componante (defined at u-point) 64 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: py2 ! j-componante (defined at v-point) 70 65 !!---------------------------------------------------------------------- 71 66 72 67 ! Change from geographic to stretched coordinate 73 68 ! ---------------------------------------------- 74 75 69 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 76 70 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) … … 90 84 !! (O. Marti ) Original code (repere and repcmo) 91 85 !!---------------------------------------------------------------------- 92 !! * Arguments93 86 REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) :: pxin, pyin ! vector componantes 94 87 CHARACTER(len=1), INTENT( IN ) :: cd_type ! define the nature of pt2d array grid-points … … 172 165 !! 9.2 ! 07-04 (S. Masson) Add T, F points and bugfix in cos lateral boundary 173 166 !!---------------------------------------------------------------------- 174 !! * local declarations175 167 INTEGER :: ji, jj ! dummy loop indices 176 168 !! 177 169 REAL(wp) :: & 178 170 zlam, zphi, & ! temporary scalars … … 320 312 321 313 ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 322 CALL lbc_lnk 323 CALL lbc_lnk 324 CALL lbc_lnk 325 CALL lbc_lnk 314 CALL lbc_lnk( gcost, 'T', 1. ) ; CALL lbc_lnk( gsint, 'T', -1. ) 315 CALL lbc_lnk( gcosu, 'U', 1. ) ; CALL lbc_lnk( gsinu, 'U', -1. ) 316 CALL lbc_lnk( gcosv, 'V', 1. ) ; CALL lbc_lnk( gsinv, 'V', -1. ) 317 CALL lbc_lnk( gcosf, 'F', 1. ) ; CALL lbc_lnk( gsinf, 'F', -1. ) 326 318 327 319 END SUBROUTINE angle 328 320 329 321 330 SUBROUTINE geo2oce ( pxx , pyy, pzz, cgrid, &331 p lon, plat, pte, ptn , ptv)322 SUBROUTINE geo2oce ( pxx, pyy, pzz, cgrid, & 323 pte, ptn ) 332 324 !!---------------------------------------------------------------------- 333 325 !! *** ROUTINE geo2oce *** … … 344 336 !! ! 00-08 (D. Ludicone) Reduced section at Bab el Mandeb 345 337 !! 8.5 ! 02-06 (G. Madec) F90: Free form 346 !!---------------------------------------------------------------------- 347 !! * Local declarations 348 REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) :: & 349 pxx, pyy, pzz 350 CHARACTER (len=1), INTENT( in) :: & 351 cgrid 352 REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) :: & 353 plon, plat 354 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: & 355 pte, ptn, ptv 338 !! 3.0 ! 07-08 (G. Madec) geo2oce suppress lon/lat agruments 339 !!---------------------------------------------------------------------- 340 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pxx, pyy, pzz 341 CHARACTER(len=1) , INTENT(in ) :: cgrid 342 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pte, ptn 343 !! 356 344 REAL(wp), PARAMETER :: rpi = 3.141592653E0 357 345 REAL(wp), PARAMETER :: rad = rpi / 180.e0 358 359 !! * Local variables360 346 INTEGER :: ig ! 361 362 347 !! * Local save 363 REAL(wp), SAVE, DIMENSION(jpi,jpj,4) :: & 364 zsinlon, zcoslon, & 365 zsinlat, zcoslat 366 LOGICAL, SAVE, DIMENSION (4) :: & 367 linit = .FALSE. 348 REAL(wp), SAVE, DIMENSION(jpi,jpj,4) :: zsinlon, zcoslon, zsinlat, zcoslat 349 LOGICAL , SAVE, DIMENSION(4) :: linit = .FALSE. 368 350 !!---------------------------------------------------------------------- 369 351 370 352 SELECT CASE( cgrid) 371 372 CASE ( 't' ) ;; ig = 1 373 CASE ( 'u' ) ;; ig = 2 374 CASE ( 'v' ) ;; ig = 3 375 CASE ( 'f' ) ;; ig = 4 376 377 CASE default 353 CASE ( 'T' ) 354 ig = 1 355 IF( .NOT. linit(ig) ) THEN 356 zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 357 zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 358 zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 359 zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 360 linit(ig) = .TRUE. 361 ENDIF 362 CASE ( 'U' ) 363 ig = 2 364 IF( .NOT. linit(ig) ) THEN 365 zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 366 zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 367 zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 368 zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 369 linit(ig) = .TRUE. 370 ENDIF 371 CASE ( 'V' ) 372 ig = 3 373 IF( .NOT. linit(ig) ) THEN 374 zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 375 zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 376 zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 377 zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 378 linit(ig) = .TRUE. 379 ENDIF 380 CASE ( 'F' ) 381 ig = 4 382 IF( .NOT. linit(ig) ) THEN 383 zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 384 zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 385 zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 386 zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 387 linit(ig) = .TRUE. 388 ENDIF 389 CASE default 378 390 WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid 379 391 CALL ctl_stop( ctmp1 ) 380 END SELECT 381 382 IF( .NOT. linit(ig) ) THEN 383 zsinlon (:,:,ig) = SIN (rad * plon) 384 zcoslon (:,:,ig) = COS (rad * plon) 385 zsinlat (:,:,ig) = SIN (rad * plat) 386 zcoslat (:,:,ig) = COS (rad * plat) 387 linit (ig) = .TRUE. 388 ENDIF 389 390 pte = - zsinlon (:,:,ig) * pxx + zcoslon (:,:,ig) * pyy 391 ptn = - zcoslon (:,:,ig) * zsinlat (:,:,ig) * pxx & 392 - zsinlon (:,:,ig) * zsinlat (:,:,ig) * pyy & 393 + zcoslat (:,:,ig) * pzz 394 ptv = zcoslon (:,:,ig) * zcoslat (:,:,ig) * pxx & 395 + zsinlon (:,:,ig) * zcoslat (:,:,ig) * pyy & 396 + zsinlat (:,:,ig) * pzz 397 392 END SELECT 393 394 pte = - zsinlon(:,:,ig) * pxx + zcoslon(:,:,ig) * pyy 395 ptn = - zcoslon(:,:,ig) * zsinlat(:,:,ig) * pxx & 396 - zsinlon(:,:,ig) * zsinlat(:,:,ig) * pyy & 397 + zcoslat(:,:,ig) * pzz 398 !!$ ptv = zcoslon(:,:,ig) * zcoslat(:,:,ig) * pxx & 399 !!$ + zsinlon(:,:,ig) * zcoslat(:,:,ig) * pyy & 400 !!$ + zsinlat(:,:,ig) * pzz 401 ! 398 402 END SUBROUTINE geo2oce 403 404 SUBROUTINE oce2geo ( pte, ptn, cgrid, & 405 pxx , pyy , pzz ) 406 !!---------------------------------------------------------------------- 407 !! *** ROUTINE oce2geo *** 408 !! 409 !! ** Purpose : 410 !! 411 !! ** Method : Change vector from east/north to geocentric 412 !! 413 !! History : 414 !! ! (A. Caubel) oce2geo - Original code 415 !!---------------------------------------------------------------------- 416 REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) :: pte, ptn 417 CHARACTER(len=1) , INTENT( IN ) :: cgrid 418 REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT ) :: pxx , pyy , pzz 419 !! 420 REAL(wp), PARAMETER :: rpi = 3.141592653E0 421 REAL(wp), PARAMETER :: rad = rpi / 180.e0 422 INTEGER :: ig ! 423 !! * Local save 424 REAL(wp), SAVE, DIMENSION(jpi,jpj,4) :: zsinlon, zcoslon, zsinlat, zcoslat 425 LOGICAL , SAVE, DIMENSION(4) :: linit = .FALSE. 426 !!---------------------------------------------------------------------- 427 428 SELECT CASE( cgrid) 429 CASE ( 'T' ) 430 ig = 1 431 IF( .NOT. linit(ig) ) THEN 432 zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 433 zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 434 zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 435 zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 436 linit(ig) = .TRUE. 437 ENDIF 438 CASE ( 'U' ) 439 ig = 2 440 IF( .NOT. linit(ig) ) THEN 441 zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 442 zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 443 zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 444 zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 445 linit(ig) = .TRUE. 446 ENDIF 447 CASE ( 'V' ) 448 ig = 3 449 IF( .NOT. linit(ig) ) THEN 450 zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 451 zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 452 zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 453 zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 454 linit(ig) = .TRUE. 455 ENDIF 456 CASE ( 'F' ) 457 ig = 4 458 IF( .NOT. linit(ig) ) THEN 459 zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 460 zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 461 zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 462 zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 463 linit(ig) = .TRUE. 464 ENDIF 465 CASE default 466 WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid 467 CALL ctl_stop( ctmp1 ) 468 END SELECT 469 470 pxx = - zsinlon(:,:,ig) * pte - zcoslon(:,:,ig) * zsinlat(:,:,ig) * ptn 471 pyy = zcoslon(:,:,ig) * pte - zsinlon(:,:,ig) * zsinlat(:,:,ig) * ptn 472 pzz = zcoslat(:,:,ig) * ptn 473 474 475 END SUBROUTINE oce2geo 399 476 400 477 … … 446 523 END SUBROUTINE repere 447 524 525 SUBROUTINE obs_rot ( psinu, pcosu, psinv, pcosv ) 526 !!---------------------------------------------------------------------- 527 !! *** ROUTINE obs_rot *** 528 !! 529 !! ** Purpose : Copy gsinu, gcosu, gsinv and gsinv 530 !! to input data for rotations of 531 !! current at observation points 532 !! 533 !! History : 534 !! 9.2 ! 09-02 (K. Mogensen) 535 !!---------------------------------------------------------------------- 536 REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT ):: & 537 & psinu, pcosu, psinv, pcosv! copy of data 538 539 !!---------------------------------------------------------------------- 540 541 ! Initialization of gsin* and gcos* at first call 542 ! ----------------------------------------------- 543 544 IF( lmust_init ) THEN 545 IF(lwp) WRITE(numout,*) 546 IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched' 547 IF(lwp) WRITE(numout,*) ' ~~~~~~~ coordinate transformation' 548 549 CALL angle ! initialization of the transformation 550 lmust_init = .FALSE. 551 552 ENDIF 553 554 psinu(:,:) = gsinu(:,:) 555 pcosu(:,:) = gcosu(:,:) 556 psinv(:,:) = gsinv(:,:) 557 pcosv(:,:) = gcosv(:,:) 558 559 END SUBROUTINE obs_rot 560 561 448 562 !!====================================================================== 449 563 END MODULE geo2ocean
Note: See TracChangeset
for help on using the changeset viewer.
