Changeset 1605 for trunk/NEMO/NST_SRC
- Timestamp:
- 2009-08-11T14:33:40+02:00 (15 years ago)
- Location:
- trunk/NEMO/NST_SRC
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/NST_SRC/agrif_oce.F90
r1152 r1605 1 1 MODULE agrif_oce 2 !!====================================================================== 3 !! *** MODULE agrif_oce *** 4 !! AGRIF : define in memory AGRIF variables 2 5 !!---------------------------------------------------------------------- 3 !! *** MODULE agrif_oce *** 4 !! 5 !! ** Purpose : Define in memory agrif variables 6 !! History : 2.0 ! 2007-12 (R. Benshila) Original code 6 7 !!---------------------------------------------------------------------- 7 !! History : 8 !! 9.0 ! 07-12 (R. Benshila) initial version 8 #if defined key_agrif 9 9 !!---------------------------------------------------------------------- 10 !! OPA 9.0 , LOCEAN-IPSL (2006) 11 !! $Id$ 12 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 10 !! 'key_agrif' AGRIF zoom 13 11 !!---------------------------------------------------------------------- 14 !! * Modules used15 12 USE par_oce ! ocean parameters 16 13 USE dom_oce ! domain parameters … … 19 16 PUBLIC 20 17 21 #if defined key_agrif 18 ! !!* Namelist namagrif: AGRIF parameters 19 LOGICAL , PUBLIC :: ln_spc_dyn = .FALSE. !: 20 INTEGER , PUBLIC :: nn_cln_update = 3 !: update frequency 21 REAL(wp), PUBLIC :: rn_sponge_tra = rdt !: sponge coeff. for tracers 22 REAL(wp), PUBLIC :: rn_sponge_dyn = rdt !: sponge coeff. for dynamics 22 23 23 !! Namelist parameters (namagrif) 24 !! ------------------------------ 25 LOGICAL, PUBLIC :: ln_spc_dyn = .FALSE. 26 INTEGER, PUBLIC :: nbclineupdate = 3 !: update frequency 27 REAL(wp), PUBLIC :: visc_tra = rdt !: sponge coeff. for tracers 28 REAL(wp), PUBLIC :: visc_dyn = rdt !: sponge coeff. for dynamics 24 ! !!! OLD namelist names 25 INTEGER , PUBLIC :: nbclineupdate !: update frequency 26 REAL(wp), PUBLIC :: visc_tra !: sponge coeff. for tracers 27 REAL(wp), PUBLIC :: visc_dyn !: sponge coeff. for dynamics 29 28 30 !! Use for sponge computation 31 !! -------------------------- 32 LOGICAL, PUBLIC :: spongedoneT = .FALSE. 33 LOGICAL, PUBLIC :: spongedoneU = .FALSE. 34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & 35 spe1ur, spe2vr ,spbtr2, spe1ur2, spe2vr2, spbtr3 29 LOGICAL , PUBLIC :: spongedoneT = .FALSE. !: tracer sponge layer indicator 30 LOGICAL , PUBLIC :: spongedoneU = .FALSE. !: dynamics sponge layer indicator 31 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: spe1ur, spe2vr ,spbtr2, spe1ur2, spe2vr2, spbtr3 !: ??? 32 36 33 #endif 37 34 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 36 !! $Id$ 37 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 38 !!====================================================================== 38 39 END MODULE agrif_oce -
trunk/NEMO/NST_SRC/agrif_opa_interp.F90
r1300 r1605 1 1 MODULE agrif_opa_interp 2 !!====================================================================== 3 !! *** MODULE agrif_opa_interp *** 4 !! AGRIF: interpolation package 5 !!====================================================================== 6 !! History : 2.0 ! 2002-06 (XXX) Original cade 7 !! - ! 2005-11 (XXX) 8 !! 3.2 ! 2009-04 (R. Benshila) 9 !!---------------------------------------------------------------------- 2 10 #if defined key_agrif && ! defined key_off_tra 11 !!---------------------------------------------------------------------- 12 !! 'key_agrif' AGRIF zoom 13 !! NOT 'key_off_tra' NO off-line tracers 14 !!---------------------------------------------------------------------- 15 !! Agrif_tra : 16 !! Agrif_dyn : 17 !! interpu : 18 !! interpv : 19 !!---------------------------------------------------------------------- 3 20 USE par_oce 4 21 USE oce … … 6 23 USE sol_oce 7 24 USE agrif_oce 25 USE phycst 26 USE in_out_manager 8 27 9 28 IMPLICIT NONE 10 29 PRIVATE 11 30 12 PUBLIC Agrif_tra, Agrif_dyn, interpu, interpv 13 14 !!---------------------------------------------------------------------- 15 !! OPA 9.0 , LOCEAN-IPSL (2006) 31 PUBLIC Agrif_tra, Agrif_dyn, interpu, interpv 32 33 # include "domzgr_substitute.h90" 34 # include "vectopt_loop_substitute.h90" 35 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 16 37 !! $Id$ 17 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 21 42 22 43 SUBROUTINE Agrif_tra 23 !!--------------------------------------------- 24 !! *** ROUTINE Agrif_Tra *** 25 !!--------------------------------------------- 26 # include "domzgr_substitute.h90" 27 # include "vectopt_loop_substitute.h90" 28 29 INTEGER :: ji,jj,jk 30 REAL(wp) :: zrhox 31 REAL(wp) :: alpha1, alpha2, alpha3, alpha4 32 REAL(wp) :: alpha5, alpha6, alpha7 33 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zta, zsa 44 !!---------------------------------------------------------------------- 45 !! *** ROUTINE Agrif_Tra *** 46 !!---------------------------------------------------------------------- 47 INTEGER :: ji, jj, jk ! dummy loop indices 48 REAL(wp) :: zrhox , alpha1, alpha2, alpha3 49 REAL(wp) :: alpha4, alpha5, alpha6, alpha7 50 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zta, zsa ! 3D workspace 51 !!---------------------------------------------------------------------- 34 52 ! 35 IF( Agrif_Root())RETURN36 37 Agrif_SpecialValue =0.53 IF( Agrif_Root() ) RETURN 54 55 Agrif_SpecialValue = 0.e0 38 56 Agrif_UseSpecialValue = .TRUE. 39 zta = 0.e040 zsa = 0.e041 42 CALL Agrif_Bc_variable( zta,tn)43 CALL Agrif_Bc_variable( zsa,sn)57 zta(:,:,:) = 0.e0 58 zsa(:,:,:) = 0.e0 59 60 CALL Agrif_Bc_variable( zta, tn ) 61 CALL Agrif_Bc_variable( zsa, sn ) 44 62 Agrif_UseSpecialValue = .FALSE. 45 63 46 64 zrhox = Agrif_Rhox() 47 65 48 alpha1 = ( zrhox-1.)/2.49 alpha2 = 1. -alpha150 51 alpha3 = ( zrhox-1)/(zrhox+1)52 alpha4 = 1. -alpha353 54 alpha6 = 2. *(zrhox-1.)/(zrhox+1.)55 alpha7 = -(zrhox-1)/(zrhox+3)66 alpha1 = ( zrhox - 1. ) * 0.5 67 alpha2 = 1. - alpha1 68 69 alpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 70 alpha4 = 1. - alpha3 71 72 alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 73 alpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 56 74 alpha5 = 1. - alpha6 - alpha7 57 75 58 IF( (nbondi == 1).OR.(nbondi == 2)) THEN76 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 59 77 60 78 ta(nlci,:,:) = alpha1 * zta(nlci,:,:) + alpha2 * zta(nlci-1,:,:) 61 79 sa(nlci,:,:) = alpha1 * zsa(nlci,:,:) + alpha2 * zsa(nlci-1,:,:) 62 80 63 DO jk =1,jpk64 DO jj =1,jpj65 IF (umask(nlci-2,jj,jk).EQ.0.) THEN81 DO jk = 1, jpkm1 82 DO jj = 1, jpj 83 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 66 84 ta(nlci-1,jj,jk) = ta(nlci,jj,jk) * tmask(nlci-1,jj,jk) 67 85 sa(nlci-1,jj,jk) = sa(nlci,jj,jk) * tmask(nlci-1,jj,jk) … … 69 87 ta(nlci-1,jj,jk)=(alpha4*ta(nlci,jj,jk)+alpha3*ta(nlci-2,jj,jk))*tmask(nlci-1,jj,jk) 70 88 sa(nlci-1,jj,jk)=(alpha4*sa(nlci,jj,jk)+alpha3*sa(nlci-2,jj,jk))*tmask(nlci-1,jj,jk) 71 IF (un(nlci-2,jj,jk).GT.0.) THEN89 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 72 90 ta(nlci-1,jj,jk)=( alpha6*ta(nlci-2,jj,jk)+alpha5*ta(nlci,jj,jk) & 73 91 & + alpha7*ta(nlci-3,jj,jk) ) * tmask(nlci-1,jj,jk) 74 92 sa(nlci-1,jj,jk)=( alpha6*sa(nlci-2,jj,jk)+alpha5*sa(nlci,jj,jk) & 75 93 & + alpha7*sa(nlci-3,jj,jk) ) * tmask(nlci-1,jj,jk) 76 94 ENDIF 77 95 ENDIF … … 80 98 ENDIF 81 99 82 IF( (nbondj == 1).OR.(nbondj == 2)) THEN100 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 83 101 84 102 ta(:,nlcj,:) = alpha1 * zta(:,nlcj,:) + alpha2 * zta(:,nlcj-1,:) 85 103 sa(:,nlcj,:) = alpha1 * zsa(:,nlcj,:) + alpha2 * zsa(:,nlcj-1,:) 86 104 87 DO jk =1,jpk88 DO ji =1,jpi89 IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN105 DO jk = 1, jpkm1 106 DO ji = 1, jpi 107 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 90 108 ta(ji,nlcj-1,jk) = ta(ji,nlcj,jk) * tmask(ji,nlcj-1,jk) 91 109 sa(ji,nlcj-1,jk) = sa(ji,nlcj,jk) * tmask(ji,nlcj-1,jk) … … 93 111 ta(ji,nlcj-1,jk)=(alpha4*ta(ji,nlcj,jk)+alpha3*ta(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk) 94 112 sa(ji,nlcj-1,jk)=(alpha4*sa(ji,nlcj,jk)+alpha3*sa(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk) 95 IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN113 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 96 114 ta(ji,nlcj-1,jk)=( alpha6*ta(ji,nlcj-2,jk)+alpha5*ta(ji,nlcj,jk) & 97 115 & + alpha7*ta(ji,nlcj-3,jk) ) * tmask(ji,nlcj-1,jk) 98 116 sa(ji,nlcj-1,jk)=( alpha6*sa(ji,nlcj-2,jk)+alpha5*sa(ji,nlcj,jk) & 99 117 & + alpha7*sa(ji,nlcj-3,jk))*tmask(ji,nlcj-1,jk) 100 118 ENDIF 101 119 ENDIF … … 104 122 ENDIF 105 123 106 IF( (nbondi == -1).OR.(nbondi == 2)) THEN124 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 107 125 ta(1,:,:) = alpha1 * zta(1,:,:) + alpha2 * zta(2,:,:) 108 126 sa(1,:,:) = alpha1 * zsa(1,:,:) + alpha2 * zsa(2,:,:) 109 DO jk =1,jpk110 DO jj =1,jpj111 IF (umask(2,jj,jk).EQ.0.) THEN127 DO jk = 1, jpkm1 128 DO jj = 1, jpj 129 IF( umask(2,jj,jk) == 0.e0 ) THEN 112 130 ta(2,jj,jk) = ta(1,jj,jk) * tmask(2,jj,jk) 113 131 sa(2,jj,jk) = sa(1,jj,jk) * tmask(2,jj,jk) … … 115 133 ta(2,jj,jk)=(alpha4*ta(1,jj,jk)+alpha3*ta(3,jj,jk))*tmask(2,jj,jk) 116 134 sa(2,jj,jk)=(alpha4*sa(1,jj,jk)+alpha3*sa(3,jj,jk))*tmask(2,jj,jk) 117 IF (un(2,jj,jk).LT.0.) THEN135 IF( un(2,jj,jk) < 0.e0 ) THEN 118 136 ta(2,jj,jk)=(alpha6*ta(3,jj,jk)+alpha5*ta(1,jj,jk)+alpha7*ta(4,jj,jk))*tmask(2,jj,jk) 119 137 sa(2,jj,jk)=(alpha6*sa(3,jj,jk)+alpha5*sa(1,jj,jk)+alpha7*sa(4,jj,jk))*tmask(2,jj,jk) … … 124 142 ENDIF 125 143 126 IF( (nbondj == -1).OR.(nbondj == 2)) THEN144 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 127 145 ta(:,1,:) = alpha1 * zta(:,1,:) + alpha2 * zta(:,2,:) 128 146 sa(:,1,:) = alpha1 * zsa(:,1,:) + alpha2 * zsa(:,2,:) 129 147 DO jk=1,jpk 130 148 DO ji=1,jpi 131 IF (vmask(ji,2,jk).EQ.0.) THEN149 IF( vmask(ji,2,jk) == 0.e0 ) THEN 132 150 ta(ji,2,jk)=ta(ji,1,jk) * tmask(ji,2,jk) 133 151 sa(ji,2,jk)=sa(ji,1,jk) * tmask(ji,2,jk) … … 135 153 ta(ji,2,jk)=(alpha4*ta(ji,1,jk)+alpha3*ta(ji,3,jk))*tmask(ji,2,jk) 136 154 sa(ji,2,jk)=(alpha4*sa(ji,1,jk)+alpha3*sa(ji,3,jk))*tmask(ji,2,jk) 137 IF (vn(ji,2,jk) .LT. 0.) THEN155 IF( vn(ji,2,jk) < 0.e0 ) THEN 138 156 ta(ji,2,jk)=(alpha6*ta(ji,3,jk)+alpha5*ta(ji,1,jk)+alpha7*ta(ji,4,jk))*tmask(ji,2,jk) 139 157 sa(ji,2,jk)=(alpha6*sa(ji,3,jk)+alpha5*sa(ji,1,jk)+alpha7*sa(ji,4,jk))*tmask(ji,2,jk) … … 143 161 END DO 144 162 ENDIF 145 163 ! 146 164 END SUBROUTINE Agrif_tra 147 165 166 148 167 SUBROUTINE Agrif_dyn( kt ) 149 !!--------------------------------------------- 150 !! *** ROUTINE Agrif_DYN *** 151 !!--------------------------------------------- 152 USE phycst 153 USE in_out_manager 154 155 # include "domzgr_substitute.h90" 156 157 INTEGER, INTENT(in) :: kt 158 168 !!---------------------------------------------------------------------- 169 !! *** ROUTINE Agrif_DYN *** 170 !!---------------------------------------------------------------------- 171 INTEGER, INTENT(in) :: kt 172 !! 173 INTEGER :: ji,jj,jk 159 174 REAL(wp) :: timeref 160 175 REAL(wp) :: z2dt, znugdt … … 163 178 REAL(wp), DIMENSION(jpi,jpj) :: spgu1,spgv1 164 179 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zua, zva 165 INTEGER :: ji,jj,jk166 167 IF (Agrif_Root())RETURN180 !!---------------------------------------------------------------------- 181 182 IF( Agrif_Root() ) RETURN 168 183 169 184 zrhox = Agrif_Rhox() … … 177 192 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 178 193 ! coefficients 179 znugdt = rnu *grav * z2dt194 znugdt = grav * z2dt 180 195 181 196 Agrif_SpecialValue=0. … … 505 520 END SUBROUTINE Agrif_dyn 506 521 522 507 523 SUBROUTINE interpu(tabres,i1,i2,j1,j2,k1,k2) 508 !!--------------------------------------------- 509 !! *** ROUTINE interpu *** 510 !!--------------------------------------------- 511 # include "domzgr_substitute.h90" 512 524 !!---------------------------------------------------------------------- 525 !! *** ROUTINE interpu *** 526 !!---------------------------------------------------------------------- 513 527 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 514 528 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 515 529 !! 516 530 INTEGER :: ji,jj,jk 531 !!---------------------------------------------------------------------- 517 532 518 533 DO jk=k1,k2 … … 528 543 END SUBROUTINE interpu 529 544 545 530 546 SUBROUTINE interpu2d(tabres,i1,i2,j1,j2) 531 !!--------------------------------------------- 532 !! *** ROUTINE interpu2d *** 533 !!--------------------------------------------- 534 547 !!---------------------------------------------------------------------- 548 !! *** ROUTINE interpu2d *** 549 !!---------------------------------------------------------------------- 535 550 INTEGER, INTENT(in) :: i1,i2,j1,j2 536 551 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 537 552 !! 538 553 INTEGER :: ji,jj 554 !!---------------------------------------------------------------------- 539 555 540 556 DO jj=j1,j2 … … 547 563 END SUBROUTINE interpu2d 548 564 565 549 566 SUBROUTINE interpv(tabres,i1,i2,j1,j2,k1,k2) 550 !!--------------------------------------------- 551 !! *** ROUTINE interpv *** 552 !!--------------------------------------------- 553 # include "domzgr_substitute.h90" 554 567 !!---------------------------------------------------------------------- 568 !! *** ROUTINE interpv *** 569 !!---------------------------------------------------------------------- 555 570 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 556 571 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 557 572 !! 558 573 INTEGER :: ji, jj, jk 574 !!---------------------------------------------------------------------- 559 575 560 576 DO jk=k1,k2 … … 571 587 END SUBROUTINE interpv 572 588 589 573 590 SUBROUTINE interpv2d(tabres,i1,i2,j1,j2) 574 !!--------------------------------------------- 575 !! *** ROUTINE interpv2d *** 576 !!--------------------------------------------- 577 591 !!---------------------------------------------------------------------- 592 !! *** ROUTINE interpu2d *** 593 !!---------------------------------------------------------------------- 578 594 INTEGER, INTENT(in) :: i1,i2,j1,j2 579 595 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 580 596 !! 581 597 INTEGER :: ji,jj 598 !!---------------------------------------------------------------------- 582 599 583 600 DO jj=j1,j2 … … 591 608 592 609 #else 610 !!---------------------------------------------------------------------- 611 !! Empty module no AGRIF zoom 612 !!---------------------------------------------------------------------- 593 613 CONTAINS 594 595 614 SUBROUTINE Agrif_OPA_Interp_empty 596 !!---------------------------------------------597 !! *** ROUTINE agrif_OPA_Interp_empty ***598 !!---------------------------------------------599 615 WRITE(*,*) 'agrif_opa_interp : You should not have seen this print! error?' 600 616 END SUBROUTINE Agrif_OPA_Interp_empty 601 617 #endif 618 619 !!====================================================================== 602 620 END MODULE agrif_opa_interp -
trunk/NEMO/NST_SRC/agrif_user.F90
r1465 r1605 7 7 8 8 SUBROUTINE Agrif_InitWorkspace 9 !!------------------------------------------ 10 !! *** ROUTINE Agrif_InitWorkspace ***11 !!------------------------------------------ 9 !!---------------------------------------------------------------------- 10 !! *** ROUTINE Agrif_InitWorkspace *** 11 !!---------------------------------------------------------------------- 12 12 USE par_oce 13 13 USE dom_oce 14 14 USE Agrif_Util 15 15 !! 16 16 IMPLICIT NONE 17 17 !! 18 18 #if defined key_mpp_dyndist 19 19 CHARACTER(len=20) :: namelistname 20 20 INTEGER nummpp 21 NAMELIST/nam_mpp_dyndist/jpni,jpnj,jpnij 22 23 IF (Agrif_Nbstepint() .EQ. 0) THEN 21 NAMELIST/nammpp_dyndist/ jpni, jpnj, jpnij 22 #endif 23 !!---------------------------------------------------------------------- 24 25 #if defined key_mpp_dyndist 26 ! MPP dynamical distribution : read the processor cutting in the namelist 27 IF( Agrif_Nbstepint() == 0 ) THEN 24 28 nummpp = Agrif_Get_Unit() 25 29 namelistname='namelist' 26 IF (.NOT. Agrif_Root()) namelistname=TRIM(Agrif_CFixed())//'_namelist' 27 OPEN(nummpp,file=namelistname,status='OLD',form='formatted') 28 READ (nummpp,nam_mpp_dyndist) 30 IF(.NOT. Agrif_Root() ) namelistname=TRIM(Agrif_CFixed())//'_namelist' 31 ! 32 OPEN (nummpp,file=namelistname,status='OLD',form='formatted') 33 READ (nummpp,nammpp_dyndist) 29 34 CLOSE(nummpp) 30 35 ENDIF … … 32 37 33 38 IF( .NOT. Agrif_Root() ) THEN 34 jpiglo = nbcellsx + 2 + 2*nbghostcells35 jpjglo = nbcellsy + 2 + 2*nbghostcells36 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci37 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj38 jpim1 = jpi-139 jpjm1 = jpj-140 jpkm1 = jpk-141 jpij = jpi*jpj42 jpidta = jpiglo43 jpjdta = jpjglo39 jpiglo = nbcellsx + 2 + 2*nbghostcells 40 jpjglo = nbcellsy + 2 + 2*nbghostcells 41 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 42 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 43 jpim1 = jpi-1 44 jpjm1 = jpj-1 45 jpkm1 = jpk-1 46 jpij = jpi*jpj 47 jpidta = jpiglo 48 jpjdta = jpjglo 44 49 jpizoom = 1 45 50 jpjzoom = 1 46 nperio = 047 jperio = 051 nperio = 0 52 jperio = 0 48 53 ENDIF 49 54 ! 50 55 END SUBROUTINE Agrif_InitWorkspace 51 56 52 !53 57 #if ! defined key_off_tra 54 58 55 59 SUBROUTINE Agrif_InitValues 56 !!------------------------------------------ 57 !! *** ROUTINE Agrif_InitValues *** 58 !! 59 !! ** Purpose :: Declaration of variables to 60 !! be interpolated 61 !!------------------------------------------ 60 !!---------------------------------------------------------------------- 61 !! *** ROUTINE Agrif_InitValues *** 62 !! 63 !! ** Purpose :: Declaration of variables to be interpolated 64 !!---------------------------------------------------------------------- 62 65 USE Agrif_Util 63 66 USE oce … … 78 81 USE agrif_top_interp 79 82 USE agrif_top_sponge 80 83 !! 81 84 IMPLICIT NONE 82 85 !! 83 86 REAL(wp) :: tabtemp(jpi,jpj,jpk) 84 87 #if defined key_top … … 86 89 #endif 87 90 LOGICAL check_namelist 91 !!---------------------------------------------------------------------- 88 92 89 93 ! 0. Initializations … … 313 317 #endif 314 318 nbcline = 0 315 319 ! 316 320 END SUBROUTINE Agrif_InitValues 317 !318 321 319 322 #else 323 320 324 SUBROUTINE Agrif_InitValues 321 !!------------------------------------------ 322 !! *** ROUTINE Agrif_InitValues *** 323 !! 324 !! ** Purpose :: Declaration of variables to 325 !! be interpolated 326 !!------------------------------------------ 325 !!---------------------------------------------------------------------- 326 !! *** ROUTINE Agrif_InitValues *** 327 !! 328 !! ** Purpose :: Declaration of variables to be interpolated 329 !!---------------------------------------------------------------------- 327 330 USE Agrif_Util 328 331 USE oce … … 334 337 USE agrif_top_interp 335 338 USE agrif_top_sponge 336 339 !! 337 340 IMPLICIT NONE 338 341 !! 339 342 REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra) 340 343 LOGICAL check_namelist 344 !!---------------------------------------------------------------------- 341 345 342 346 ! 0. Initializations … … 441 445 CALL Agrif_Update_trc(0) 442 446 nbcline_trc = 0 443 447 ! 444 448 END SUBROUTINE Agrif_InitValues 449 445 450 #endif 446 451 447 SUBROUTINE Agrif_detect(g,sizex)448 !!------------------------------------------ 452 SUBROUTINE Agrif_detect( g, sizex ) 453 !!---------------------------------------------------------------------- 449 454 !! *** ROUTINE Agrif_detect *** 450 !!------------------------------------------ 455 !!---------------------------------------------------------------------- 451 456 USE Agrif_Types 452 457 !! 453 458 INTEGER, DIMENSION(2) :: sizex 454 459 INTEGER, DIMENSION(sizex(1),sizex(2)) :: g 455 456 Return 457 458 End SUBROUTINE Agrif_detect 460 !!---------------------------------------------------------------------- 461 ! 462 RETURN 463 ! 464 END SUBROUTINE Agrif_detect 465 459 466 460 467 SUBROUTINE agrif_opa_init 461 !!--------------------------------------------- 462 !! *** ROUTINE agrif_init ***463 !!--------------------------------------------- 468 !!---------------------------------------------------------------------- 469 !! *** ROUTINE agrif_init *** 470 !!---------------------------------------------------------------------- 464 471 USE agrif_oce 465 472 USE in_out_manager 466 473 !! 467 474 IMPLICIT NONE 468 469 NAMELIST/namagrif/ nbclineupdate, visc_tra, visc_dyn, ln_spc_dyn 470 471 REWIND ( numnam ) 472 READ ( numnam, namagrif ) 473 IF(lwp) THEN 475 !! 476 NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 477 !!---------------------------------------------------------------------- 478 479 REWIND( numnam ) ! Read namagrif namelist 480 READ ( numnam, namagrif ) 481 ! 482 IF(lwp) THEN ! control print 474 483 WRITE(numout,*) 475 WRITE(numout,*) 'agrif_opa_init : agrifparameters'484 WRITE(numout,*) 'agrif_opa_init : AGRIF parameters' 476 485 WRITE(numout,*) '~~~~~~~~~~~~' 477 WRITE(numout,*) ' Namelist namagrif : set agrifparameters'478 WRITE(numout,*) ' baroclinic update frequency = ', nbclineupdate479 WRITE(numout,*) ' sponge coefficient for tracers = ', visc_tra480 WRITE(numout,*) ' sponge coefficient for dynamics = ', visc_dyn481 WRITE(numout,*) ' use special values for dynamics =', ln_spc_dyn486 WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' 487 WRITE(numout,*) ' baroclinic update frequency nn_cln_update = ', nn_cln_update 488 WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' s' 489 WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' s' 490 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 482 491 WRITE(numout,*) 483 492 ENDIF 484 493 ! 494 ! convert DOCTOR namelist name into OLD names 495 nbclineupdate = nn_cln_update 496 visc_tra = rn_sponge_tra 497 visc_dyn = rn_sponge_dyn 498 ! 485 499 END SUBROUTINE agrif_opa_init 486 #if defined key_mpp_mpi 487 SUBROUTINE Agrif_InvLoc(indloc,nprocloc,i,indglob) 488 !!------------------------------------------ 489 !! *** ROUTINE Agrif_detect *** 490 !!------------------------------------------ 500 501 # if defined key_mpp_mpi 502 503 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 504 !!---------------------------------------------------------------------- 505 !! *** ROUTINE Agrif_detect *** 506 !!---------------------------------------------------------------------- 491 507 USE dom_oce 492 508 !! 493 509 IMPLICIT NONE 494 510 !! 495 511 INTEGER :: indglob,indloc,nprocloc,i 496 512 !!---------------------------------------------------------------------- 513 ! 497 514 SELECT CASE(i) 498 515 CASE(1) … … 505 522 indglob = indloc 506 523 END SELECT 507 524 ! 508 525 END SUBROUTINE Agrif_InvLoc 509 #endif 526 527 # endif 528 510 529 #else 511 530 SUBROUTINE Subcalledbyagrif 512 !!------------------------------------------ 531 !!---------------------------------------------------------------------- 513 532 !! *** ROUTINE Subcalledbyagrif *** 514 !!------------------------------------------ 533 !!---------------------------------------------------------------------- 515 534 WRITE(*,*) 'Impossible to be here' 516 535 END SUBROUTINE Subcalledbyagrif
Note: See TracChangeset
for help on using the changeset viewer.