Changeset 1218 for trunk/NEMO/OPA_SRC/geo2ocean.F90
- Timestamp:
- 2008-10-28T10:12:16+01:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/geo2ocean.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/geo2ocean.F90
r1152 r1218 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 28 27 !! * Module variables28 29 REAL(wp), DIMENSION(jpi,jpj) :: & 29 30 gsint, gcost, & ! cos/sin between model grid lines and NP direction at T point … … 34 35 LOGICAL :: lmust_init = .TRUE. !: used to initialize the cos/sin variables (se above) 35 36 36 !! * Substitutions37 !! * Substitutions 37 38 # 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 !!---------------------------------------------------------------------- -----------39 !!---------------------------------------------------------------------- 40 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 41 !! $Id:$ 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 43 !!---------------------------------------------------------------------- 43 44 44 45 CONTAINS … … 54 55 !! ** Method : Initialization of arrays at the first call. 55 56 !! 56 !! ** Action : - px2 : first componante (defined at u point)57 !! ** Action : - px2 : first componante (defined at u point) 57 58 !! - 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) 59 !!---------------------------------------------------------------------- 60 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pxu1, pyu1 ! geographic vector componantes at u-point 61 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pxv1, pyv1 ! geographic vector componantes at v-point 62 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: px2 ! i-componante (defined at u-point) 63 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: py2 ! j-componante (defined at v-point) 70 64 !!---------------------------------------------------------------------- 71 65 72 66 ! Change from geographic to stretched coordinate 73 67 ! ---------------------------------------------- 74 75 68 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 76 69 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) … … 90 83 !! (O. Marti ) Original code (repere and repcmo) 91 84 !!---------------------------------------------------------------------- 92 !! * Arguments93 85 REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) :: pxin, pyin ! vector componantes 94 86 CHARACTER(len=1), INTENT( IN ) :: cd_type ! define the nature of pt2d array grid-points … … 172 164 !! 9.2 ! 07-04 (S. Masson) Add T, F points and bugfix in cos lateral boundary 173 165 !!---------------------------------------------------------------------- 174 !! * local declarations175 166 INTEGER :: ji, jj ! dummy loop indices 176 167 !! 177 168 REAL(wp) :: & 178 169 zlam, zphi, & ! temporary scalars … … 328 319 329 320 330 SUBROUTINE geo2oce ( pxx , pyy, pzz, cgrid, &331 p lon, plat, pte, ptn , ptv)321 SUBROUTINE geo2oce ( pxx, pyy, pzz, cgrid, & 322 pte, ptn ) 332 323 !!---------------------------------------------------------------------- 333 324 !! *** ROUTINE geo2oce *** … … 344 335 !! ! 00-08 (D. Ludicone) Reduced section at Bab el Mandeb 345 336 !! 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 337 !! 3.0 ! 07-08 (G. Madec) geo2oce suppress lon/lat agruments 338 !!---------------------------------------------------------------------- 339 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pxx, pyy, pzz 340 CHARACTER(len=1) , INTENT(in ) :: cgrid 341 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pte, ptn 342 !! 356 343 REAL(wp), PARAMETER :: rpi = 3.141592653E0 357 344 REAL(wp), PARAMETER :: rad = rpi / 180.e0 358 359 !! * Local variables360 345 INTEGER :: ig ! 361 362 346 !! * Local save 363 REAL(wp), SAVE, DIMENSION(jpi,jpj,4) :: & 364 zsinlon, zcoslon, & 365 zsinlat, zcoslat 366 LOGICAL, SAVE, DIMENSION (4) :: & 367 linit = .FALSE. 347 REAL(wp), SAVE, DIMENSION(jpi,jpj,4) :: zsinlon, zcoslon, zsinlat, zcoslat 348 LOGICAL , SAVE, DIMENSION(4) :: linit = .FALSE. 368 349 !!---------------------------------------------------------------------- 369 350 370 351 SELECT CASE( cgrid) 371 352 CASE ( 't' ) 353 ig = 1 354 IF( .NOT. linit(ig) ) THEN 355 zsinlon (:,:,ig) = SIN (rad * glamt) 356 zcoslon (:,:,ig) = COS (rad * glamt) 357 zsinlat (:,:,ig) = SIN (rad * gphit) 358 zcoslat (:,:,ig) = COS (rad * gphit) 359 linit (ig) = .TRUE. 360 ENDIF 361 CASE ( 'u' ) 362 ig = 2 363 IF( .NOT. linit(ig) ) THEN 364 zsinlon (:,:,ig) = SIN (rad * glamu) 365 zcoslon (:,:,ig) = COS (rad * glamu) 366 zsinlat (:,:,ig) = SIN (rad * gphiu) 367 zcoslat (:,:,ig) = COS (rad * gphiu) 368 linit (ig) = .TRUE. 369 ENDIF 370 CASE ( 'v' ) 371 ig = 3 372 IF( .NOT. linit(ig) ) THEN 373 zsinlon (:,:,ig) = SIN (rad * glamv) 374 zcoslon (:,:,ig) = COS (rad * glamv) 375 zsinlat (:,:,ig) = SIN (rad * gphiv) 376 zcoslat (:,:,ig) = COS (rad * gphiv) 377 linit (ig) = .TRUE. 378 ENDIF 379 CASE ( 'f' ) 380 ig = 4 381 IF( .NOT. linit(ig) ) THEN 382 zsinlon (:,:,ig) = SIN (rad * glamf) 383 zcoslon (:,:,ig) = COS (rad * glamf) 384 zsinlat (:,:,ig) = SIN (rad * gphif) 385 zcoslat (:,:,ig) = COS (rad * gphif) 386 linit (ig) = .TRUE. 387 ENDIF 388 CASE default 389 WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid 390 CALL ctl_stop( ctmp1 ) 391 END SELECT 392 393 pte = - zsinlon (:,:,ig) * pxx + zcoslon (:,:,ig) * pyy 394 ptn = - zcoslon (:,:,ig) * zsinlat (:,:,ig) * pxx & 395 - zsinlon (:,:,ig) * zsinlat (:,:,ig) * pyy & 396 + zcoslat (:,:,ig) * pzz 397 !!$ ptv = zcoslon (:,:,ig) * zcoslat (:,:,ig) * pxx & 398 !!$ + zsinlon (:,:,ig) * zcoslat (:,:,ig) * pyy & 399 !!$ + zsinlat (:,:,ig) * pzz 400 ! 401 END SUBROUTINE geo2oce 402 403 SUBROUTINE oce2geo ( pte, ptn, cgrid, & 404 plon, plat, pxx , pyy , pzz ) 405 !!---------------------------------------------------------------------- 406 !! *** ROUTINE oce2geo *** 407 !! 408 !! ** Purpose : 409 !! 410 !! ** Method : Change vector from east/north to geocentric 411 !! 412 !! History : 413 !! ! (A. Caubel) oce2geo - Original code 414 !!---------------------------------------------------------------------- 415 REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) :: pte, ptn 416 CHARACTER(len=1) , INTENT( IN ) :: cgrid 417 REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) :: plon, plat 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 WRITE(ctmp1,*) 'oce2geo : Arnaud, au boulot ' 429 CALL ctl_stop( ctmp1 ) 430 431 SELECT CASE( cgrid) 372 432 CASE ( 't' ) ;; ig = 1 373 433 CASE ( 'u' ) ;; ig = 2 374 434 CASE ( 'v' ) ;; ig = 3 375 435 CASE ( 'f' ) ;; ig = 4 376 377 436 CASE default 378 WRITE(ctmp1,*) ' geo2oce: bad grid argument : ', cgrid437 WRITE(ctmp1,*) 'oce2geo : bad grid argument : ', cgrid 379 438 CALL ctl_stop( ctmp1 ) 380 439 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 398 END SUBROUTINE geo2oce 440 pxx(:,:) = 0. ; pyy(:,:) = 0. ; pzz(:,:) = 0. ! stupid definition to avoid warning message when compiling... 441 442 END SUBROUTINE oce2geo 399 443 400 444
Note: See TracChangeset
for help on using the changeset viewer.
