Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r2528 r2715 19 19 USE in_out_manager ! I/O manager 20 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 USE lib_mpp ! MPP library 21 22 22 23 IMPLICIT NONE … … 29 30 PUBLIC obs_rot 30 31 31 REAL(wp), DIMENSION(jpi,jpj) :: &32 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 32 33 gsint, gcost, & ! cos/sin between model grid lines and NP direction at T point 33 34 gsinu, gcosu, & ! cos/sin between model grid lines and NP direction at U point 34 35 gsinv, gcosv, & ! cos/sin between model grid lines and NP direction at V point 35 36 gsinf, gcosf ! cos/sin between model grid lines and NP direction at F point 37 38 LOGICAL , SAVE, DIMENSION(4) :: linit = .FALSE. 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gsinlon, gcoslon, gsinlat, gcoslat 36 40 37 41 LOGICAL :: lmust_init = .TRUE. !: used to initialize the cos/sin variables (se above) … … 42 46 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 43 47 !! $Id$ 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 49 !!---------------------------------------------------------------------- 46 47 50 CONTAINS 48 51 … … 93 96 !! ! 'ij->n' model i-j componantes to east componante 94 97 REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: prot 95 96 98 !!---------------------------------------------------------------------- 97 99 … … 103 105 IF(lwp) WRITE(numout,*) ' rot_rep : geographic <--> stretched' 104 106 IF(lwp) WRITE(numout,*) ' ~~~~~ coordinate transformation' 105 107 ! 106 108 CALL angle ! initialization of the transformation 107 109 lmust_init = .FALSE. 108 109 110 ENDIF 110 111 … … 166 167 !! 9.2 ! 07-04 (S. Masson) Add T, F points and bugfix in cos lateral boundary 167 168 !!---------------------------------------------------------------------- 168 INTEGER :: ji, jj 169 !!169 INTEGER :: ji, jj ! dummy loop indices 170 INTEGER :: ierr ! local integer 170 171 REAL(wp) :: & 171 172 zlam, zphi, & ! temporary scalars … … 181 182 !!---------------------------------------------------------------------- 182 183 184 ALLOCATE( gsint(jpi,jpj), gcost(jpi,jpj), & 185 & gsinu(jpi,jpj), gcosu(jpi,jpj), & 186 & gsinv(jpi,jpj), gcosv(jpi,jpj), & 187 & gsinf(jpi,jpj), gcosf(jpi,jpj), STAT=ierr ) 188 IF(lk_mpp) CALL mpp_sum( ierr ) 189 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'angle_msh_geo: unable to allocate arrays' ) 190 183 191 ! ============================= ! 184 192 ! Compute the cosinus and sinus ! … … 343 351 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pte, ptn 344 352 !! 345 REAL(wp), PARAMETER :: rpi = 3.141592653 E0353 REAL(wp), PARAMETER :: rpi = 3.141592653e0 346 354 REAL(wp), PARAMETER :: rad = rpi / 180.e0 347 355 INTEGER :: ig ! 348 !! * Local save 349 REAL(wp), SAVE, DIMENSION(jpi,jpj,4) :: zsinlon, zcoslon, zsinlat, zcoslat 350 LOGICAL , SAVE, DIMENSION(4) :: linit = .FALSE. 351 !!---------------------------------------------------------------------- 356 INTEGER :: ierr ! local integer 357 !!---------------------------------------------------------------------- 358 359 IF( .NOT. ALLOCATED( gsinlon ) ) THEN 360 ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) , & 361 & gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr ) 362 IF( lk_mpp ) CALL mpp_sum( ierr ) 363 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'angle_msh_geo: unable to allocate arrays' ) 364 ENDIF 352 365 353 366 SELECT CASE( cgrid) … … 355 368 ig = 1 356 369 IF( .NOT. linit(ig) ) THEN 357 zsinlon(:,:,ig) = SIN( rad * glamt(:,:) )358 zcoslon(:,:,ig) = COS( rad * glamt(:,:) )359 zsinlat(:,:,ig) = SIN( rad * gphit(:,:) )360 zcoslat(:,:,ig) = COS( rad * gphit(:,:) )370 gsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 371 gcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 372 gsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 373 gcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 361 374 linit(ig) = .TRUE. 362 375 ENDIF … … 364 377 ig = 2 365 378 IF( .NOT. linit(ig) ) THEN 366 zsinlon(:,:,ig) = SIN( rad * glamu(:,:) )367 zcoslon(:,:,ig) = COS( rad * glamu(:,:) )368 zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) )369 zcoslat(:,:,ig) = COS( rad * gphiu(:,:) )379 gsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 380 gcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 381 gsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 382 gcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 370 383 linit(ig) = .TRUE. 371 384 ENDIF … … 373 386 ig = 3 374 387 IF( .NOT. linit(ig) ) THEN 375 zsinlon(:,:,ig) = SIN( rad * glamv(:,:) )376 zcoslon(:,:,ig) = COS( rad * glamv(:,:) )377 zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) )378 zcoslat(:,:,ig) = COS( rad * gphiv(:,:) )388 gsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 389 gcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 390 gsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 391 gcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 379 392 linit(ig) = .TRUE. 380 393 ENDIF … … 382 395 ig = 4 383 396 IF( .NOT. linit(ig) ) THEN 384 zsinlon(:,:,ig) = SIN( rad * glamf(:,:) )385 zcoslon(:,:,ig) = COS( rad * glamf(:,:) )386 zsinlat(:,:,ig) = SIN( rad * gphif(:,:) )387 zcoslat(:,:,ig) = COS( rad * gphif(:,:) )397 gsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 398 gcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 399 gsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 400 gcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 388 401 linit(ig) = .TRUE. 389 402 ENDIF … … 393 406 END SELECT 394 407 395 pte = - zsinlon(:,:,ig) * pxx + zcoslon(:,:,ig) * pyy396 ptn = - zcoslon(:,:,ig) * zsinlat(:,:,ig) * pxx &397 - zsinlon(:,:,ig) * zsinlat(:,:,ig) * pyy &398 + zcoslat(:,:,ig) * pzz399 !!$ ptv = zcoslon(:,:,ig) * zcoslat(:,:,ig) * pxx &400 !!$ + zsinlon(:,:,ig) * zcoslat(:,:,ig) * pyy &401 !!$ + zsinlat(:,:,ig) * pzz408 pte = - gsinlon(:,:,ig) * pxx + gcoslon(:,:,ig) * pyy 409 ptn = - gcoslon(:,:,ig) * gsinlat(:,:,ig) * pxx & 410 - gsinlon(:,:,ig) * gsinlat(:,:,ig) * pyy & 411 + gcoslat(:,:,ig) * pzz 412 !!$ ptv = gcoslon(:,:,ig) * gcoslat(:,:,ig) * pxx & 413 !!$ + gsinlon(:,:,ig) * gcoslat(:,:,ig) * pyy & 414 !!$ + gsinlat(:,:,ig) * pzz 402 415 ! 403 416 END SUBROUTINE geo2oce … … 422 435 REAL(wp), PARAMETER :: rad = rpi / 180.e0 423 436 INTEGER :: ig ! 424 !! * Local save 425 REAL(wp), SAVE, DIMENSION(jpi,jpj,4) :: zsinlon, zcoslon, zsinlat, zcoslat 426 LOGICAL , SAVE, DIMENSION(4) :: linit = .FALSE. 427 !!---------------------------------------------------------------------- 437 INTEGER :: ierr ! local integer 438 !!---------------------------------------------------------------------- 439 440 IF( ALLOCATED( gsinlon ) ) THEN 441 ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) , & 442 & gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr ) 443 IF( lk_mpp ) CALL mpp_sum( ierr ) 444 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'angle_msh_geo: unable to allocate arrays' ) 445 ENDIF 428 446 429 447 SELECT CASE( cgrid) … … 431 449 ig = 1 432 450 IF( .NOT. linit(ig) ) THEN 433 zsinlon(:,:,ig) = SIN( rad * glamt(:,:) )434 zcoslon(:,:,ig) = COS( rad * glamt(:,:) )435 zsinlat(:,:,ig) = SIN( rad * gphit(:,:) )436 zcoslat(:,:,ig) = COS( rad * gphit(:,:) )451 gsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 452 gcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 453 gsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 454 gcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 437 455 linit(ig) = .TRUE. 438 456 ENDIF … … 440 458 ig = 2 441 459 IF( .NOT. linit(ig) ) THEN 442 zsinlon(:,:,ig) = SIN( rad * glamu(:,:) )443 zcoslon(:,:,ig) = COS( rad * glamu(:,:) )444 zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) )445 zcoslat(:,:,ig) = COS( rad * gphiu(:,:) )460 gsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 461 gcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 462 gsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 463 gcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 446 464 linit(ig) = .TRUE. 447 465 ENDIF … … 449 467 ig = 3 450 468 IF( .NOT. linit(ig) ) THEN 451 zsinlon(:,:,ig) = SIN( rad * glamv(:,:) )452 zcoslon(:,:,ig) = COS( rad * glamv(:,:) )453 zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) )454 zcoslat(:,:,ig) = COS( rad * gphiv(:,:) )469 gsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 470 gcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 471 gsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 472 gcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 455 473 linit(ig) = .TRUE. 456 474 ENDIF … … 458 476 ig = 4 459 477 IF( .NOT. linit(ig) ) THEN 460 zsinlon(:,:,ig) = SIN( rad * glamf(:,:) )461 zcoslon(:,:,ig) = COS( rad * glamf(:,:) )462 zsinlat(:,:,ig) = SIN( rad * gphif(:,:) )463 zcoslat(:,:,ig) = COS( rad * gphif(:,:) )478 gsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 479 gcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 480 gsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 481 gcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 464 482 linit(ig) = .TRUE. 465 483 ENDIF … … 469 487 END SELECT 470 488 471 pxx = - zsinlon(:,:,ig) * pte - zcoslon(:,:,ig) * zsinlat(:,:,ig) * ptn472 pyy = zcoslon(:,:,ig) * pte - zsinlon(:,:,ig) * zsinlat(:,:,ig) * ptn473 pzz = zcoslat(:,:,ig) * ptn489 pxx = - gsinlon(:,:,ig) * pte - gcoslon(:,:,ig) * gsinlat(:,:,ig) * ptn 490 pyy = gcoslon(:,:,ig) * pte - gsinlon(:,:,ig) * gsinlat(:,:,ig) * ptn 491 pzz = gcoslat(:,:,ig) * ptn 474 492 475 493 … … 495 513 !! 8.5 ! 02-08 (G. Madec) F90: Free form 496 514 !!---------------------------------------------------------------------- 497 !! * Arguments 498 REAL(wp), INTENT( IN ), DIMENSION(jpi,jpj) :: & 499 px1, py1 ! two horizontal components to be rotated 500 REAL(wp), INTENT( OUT ), DIMENSION(jpi,jpj) :: & 501 px2, py2 ! the two horizontal components in the model repere 502 INTEGER, INTENT( IN ) :: & 503 kchoix ! type of transformation 504 ! = 1 change from geographic to model grid. 505 ! =-1 change from model to geographic grid 506 CHARACTER(len=1), INTENT( IN ), OPTIONAL :: cd_type ! define the nature of pt2d array grid-points 515 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: px1, py1 ! two horizontal components to be rotated 516 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: px2, py2 ! the two horizontal components in the model repere 517 INTEGER , INTENT(in ) :: kchoix ! type of transformation 518 ! ! = 1 change from geographic to model grid. 519 ! ! =-1 change from model to geographic grid 520 CHARACTER(len=1), INTENT(in ), OPTIONAL :: cd_type ! define the nature of pt2d array grid-points 507 521 ! 508 522 CHARACTER(len=1) :: cl_type ! define the nature of pt2d array grid-points (T point by default) … … 536 550 !! 9.2 ! 09-02 (K. Mogensen) 537 551 !!---------------------------------------------------------------------- 538 REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT ):: & 539 & psinu, pcosu, psinv, pcosv! copy of data 540 552 REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT ):: psinu, pcosu, psinv, pcosv ! copy of data 541 553 !!---------------------------------------------------------------------- 542 554 … … 561 573 END SUBROUTINE obs_rot 562 574 563 564 575 !!====================================================================== 565 576 END MODULE geo2ocean
Note: See TracChangeset
for help on using the changeset viewer.
