- Timestamp:
- 08/02/12 20:44:58 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/etat0_dcmip1.f90
r55 r72 38 38 REAL(rstd),POINTER :: u(:,:) 39 39 REAL(rstd),POINTER :: q(:,:,:) 40 CHARACTER(len=255) :: dcmip1_adv_shape 40 41 INTEGER :: ind 41 42 42 43 R0=radius*0.5 43 44 rt=radius*0.5 45 dcmip1_adv_shape='cos_bell' 46 CALL getin('dcmip1_shape',dcmip1_adv_shape) 44 47 45 48 DO ind=1,ndomain … … 51 54 u=f_u(ind) 52 55 q=f_q(ind) 53 CALL compute_etat0_ncar(ps, phis, theta_rhodz, u, q(:,:,1)) 56 57 58 SELECT CASE(TRIM(dcmip1_adv_shape)) 59 CASE('const') 60 CALL compute_etat0_ncar(1,ps, phis, theta_rhodz, u, q(:,:,1)) 61 CASE('cos_bell') 62 CALL compute_etat0_ncar(2,ps, phis, theta_rhodz, u, q(:,:,1)) 63 CASE('slotted_cyl') 64 CALL compute_etat0_ncar(3,ps, phis, theta_rhodz, u, q(:,:,1)) 65 CASE('dbl_cos_bell_q1') 66 CALL compute_etat0_ncar(4,ps, phis, theta_rhodz, u, q(:,:,1)) 67 CASE('dbl_cos_bell_q2') 68 CALL compute_etat0_ncar(5,ps, phis, theta_rhodz, u, q(:,:,1)) 69 CASE('complement') 70 CALL compute_etat0_ncar(6,ps, phis, theta_rhodz, u, q(:,:,1)) 71 CASE('hadley') ! hadley like meridional circulation 72 CALL compute_etat0_ncar(7,ps, phis, theta_rhodz, u, q(:,:,1)) 73 CASE('dcmip11') 74 IF(nqtot==5) THEN 75 CALL compute_etat0_ncar(4,ps, phis, theta_rhodz, u, q(:,:,1)) 76 CALL compute_etat0_ncar(5,ps, phis, theta_rhodz, u, q(:,:,2)) 77 CALL compute_etat0_ncar(3,ps, phis, theta_rhodz, u, q(:,:,3)) 78 CALL compute_etat0_ncar(6,ps, phis, theta_rhodz, u, q(:,:,4)) 79 CALL compute_etat0_ncar(1,ps, phis, theta_rhodz, u, q(:,:,5)) 80 ELSE 81 PRINT *,'Error : etat0_dcmip=dcmip11 and nqtot = ',nqtot,' .' 82 PRINT *,'nqtot must be equal to 5 when etat0_dcmip=dcmip11' 83 STOP 84 END IF 85 CASE DEFAULT 86 PRINT *, 'Bad selector for variable dcmip1_adv_shape : <', TRIM(dcmip1_adv_shape), & 87 '> options are <const>, <slotted_cyl>, <cos_bell>, <dbl_cos_bell_q1>', & 88 '<dbl_cos_bell_q2>, <complement>, <hadley>' 89 STOP 90 END SELECT 91 54 92 ENDDO 55 93 56 94 END SUBROUTINE etat0 57 95 58 SUBROUTINE compute_etat0_ncar( ps, phis, theta_rhodz, u, q)96 SUBROUTINE compute_etat0_ncar(icase, ps, phis, theta_rhodz, u, q) 59 97 USE icosa 60 98 USE disvert_mod … … 64 102 USE theta2theta_rhodz_mod 65 103 IMPLICIT NONE 104 INTEGER, INTENT(in) :: icase 66 105 REAL(rstd),INTENT(OUT) :: ps(iim*jjm) 67 106 REAL(rstd),INTENT(OUT) :: phis(iim*jjm) … … 69 108 REAL(rstd),INTENT(OUT) :: u(3*iim*jjm,llm) 70 109 REAL(rstd),INTENT(OUT) :: q(iim*jjm,llm) 71 72 110 73 111 REAL(rstd) :: qxt1(iim*jjm,llm) … … 78 116 REAL(rstd) :: X2(3),X1(3) 79 117 INTEGER :: i,j,n,l 80 CHARACTER(len=255) :: ncar_adv_shape81 118 82 119 u = 0.0 ; phis = 0 ; theta_rhodz = 0 ; ps = ncar_p0 … … 91 128 END DO 92 129 93 ncar_adv_shape='cos_bell'94 CA LL getin('ncar_adv_shape',ncar_adv_shape)95 96 SELECT CASE(TRIM(ncar_adv_shape))130 SELECT CASE(icase) 131 CASE(1) 132 q=1 133 CASE(2) 97 134 !--------------------------------------------- SINGLE COSINE BELL 98 CASE('const') 99 q=1 100 CASE('cos_bell') 101 CALL cosine_bell_1(q) 102 103 CASE('slotted_cyl') 135 CALL cosine_bell_1(q) 136 CASE(3) 104 137 CALL slotted_cylinders(q) 105 106 CASE('dbl_cos_bell_q1') 107 CALL cosine_bell_2(q) 108 109 CASE('dbl_cos_bell_q2') 138 CASE(4) 139 PRINT *, 'Double cosine bell' 140 CALL cosine_bell_2(q) 141 CASE(5) 110 142 CALL cosine_bell_2(q) 111 143 DO l=1,llm 112 144 q(:,l)= 0.9 - 0.8*q(:,l)*q(:,l) 113 END DO 114 115 CASE('complement') 145 END DO 146 CASE(6) 116 147 ! tracer such that, in combination with the other tracer fields 117 148 ! with weight (3/10), the sum is equal to one … … 123 154 CALL slotted_cylinders(qxt1) 124 155 q = q + qxt1 125 q = 1. - q*0.3 126 127 CASE('hadley') ! hadley like meridional circulation 156 q = 1. - q*0.3 157 CASE(7) ! hadley like meridional circulation 128 158 CALL hadleyq(q) 129 130 CASE DEFAULT131 PRINT *, 'Bad selector for variable ncar_adv_shape : <', TRIM(ncar_adv_shape), &132 '> options are <const>, <slotted_cyl>, <cos_bell>, <dbl_cos_bell_q1>', &133 '<dbl_cos_bell_q2>, <complement>, <hadley>'134 STOP135 136 159 END SELECT 137 160 … … 228 251 IF ( zrl(l) .GT. zc ) Then 229 252 IF ( ABS(latc1 - lat) .LT. 0.125 ) Then 230 hx(n,l)= 0. 0253 hx(n,l)= 0.1 231 254 ENDIF 232 255 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.