Changeset 106
- Timestamp:
- 08/07/12 00:02:15 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/physics_dcmip.f90
r102 r106 40 40 INTEGER :: ind 41 41 42 CALL transfert_request(f_ue,req_e1) 42 43 DO ind=1,ndomain 43 44 CALL swap_dimensions(ind) … … 52 53 precl=f_precl(ind) 53 54 54 CALL compute_physics( phis, ps, theta_rhodz, ue, q(:,:, 3), precl)55 CALL compute_physics( phis, ps, theta_rhodz, ue, q(:,:,1), precl) 55 56 56 57 ENDDO 58 59 ! CALL writefield("out_i",f_out_i) 57 60 58 61 IF (mod(it,itau_out)==0 ) THEN … … 82 85 REAL(rstd) :: phi(iim*jjm,llm) 83 86 REAL(rstd) :: T(iim*jjm,llm) 87 REAL(rstd) :: Tfi(iim*jjm,llm) 84 88 REAL(rstd) :: theta(iim*jjm,llm) 85 89 … … 89 93 REAL(rstd) :: ufi(iim*jjm,llm) 90 94 REAL(rstd) :: vfi(iim*jjm,llm) 95 REAL(rstd) :: qfi(iim*jjm,llm) 96 REAL(rstd) :: utemp(iim*jjm,llm) 97 REAL(rstd) :: vtemp(iim*jjm,llm) 91 98 REAL(rstd) :: lat(iim*jjm) 92 99 REAL(rstd) :: lon 93 100 REAL(rstd) :: pmid(iim*jjm,llm) 101 REAL(rstd) :: pint(iim*jjm,llm+1) 94 102 REAL(rstd) :: pdel(iim*jjm,llm) 95 103 INTEGER :: i,j,l,ij … … 111 119 ENDDO 112 120 113 DO l=1,llm 114 DO j=jj_begin,jj_end 115 DO i=ii_begin,ii_end 116 ij=(j-1)*iim+i 117 p mid(ij,l)=0.5*(p(ij,l)+p(ij,l+1))121 DO l=1,llm+1 122 DO j=jj_begin,jj_end 123 DO i=ii_begin,ii_end 124 ij=(j-1)*iim+i 125 pint(ij,l)=p(ij,llm+2-l) 118 126 ENDDO 119 127 ENDDO … … 124 132 DO i=ii_begin,ii_end 125 133 ij=(j-1)*iim+i 126 pdel(ij,l)=p(ij,l+1)-p(ij,l) 134 pmid(ij,l)=0.5*(pint(ij,l)+pint(ij,l+1)) 135 ENDDO 136 ENDDO 137 ENDDO 138 139 DO l=1,llm 140 DO j=jj_begin,jj_end 141 DO i=ii_begin,ii_end 142 ij=(j-1)*iim+i 143 pdel(ij,l)=pint(ij,l+1)-pint(ij,l) 127 144 ENDDO 128 145 ENDDO … … 130 147 131 148 132 ufi=u133 vfi=v149 ! ufi=u 150 ! vfi=v 134 151 135 152 DO l=1,llm … … 142 159 ENDDO 143 160 144 145 CALL simple_physics(iim*jjm, llm, dt, lat, t, q , ufi, vfi, pmid, p, pdel, 1/pdel, ps, precl, testcase) 146 161 DO l=1,llm 162 DO j=jj_begin,jj_end 163 DO i=ii_begin,ii_end 164 ij=(j-1)*iim+i 165 Tfi(ij,l)=T(ij,llm+1-l) 166 ufi(ij,l)=u(ij,llm+1-l) 167 vfi(ij,l)=v(ij,llm+1-l) 168 qfi(ij,l)=q(ij,llm+1-l) 169 ENDDO 170 ENDDO 171 ENDDO 172 173 ! q=0 174 out_i=T 175 176 CALL simple_physics(iim*jjm, llm, dt, lat, tfi, qfi , ufi, vfi, pmid, pint, pdel, 1/pdel, ps, precl, testcase) 177 178 DO l=1,llm 179 DO j=jj_begin,jj_end 180 DO i=ii_begin,ii_end 181 ij=(j-1)*iim+i 182 T(ij,l)=Tfi(ij,llm+1-l) 183 utemp(ij,l)=ufi(ij,llm+1-l) 184 vtemp(ij,l)=vfi(ij,llm+1-l) 185 q(ij,l)=qfi(ij,llm+1-l) 186 ENDDO 187 ENDDO 188 ENDDO 189 190 147 191 DO l=1,llm 148 192 DO j=jj_begin,jj_end … … 153 197 ENDDO 154 198 ENDDO 199 200 out_i=q 155 201 156 u fi=ufi-u157 v fi=vfi-v158 159 DO l=1,llm 160 DO j=jj_begin,jj_end 161 DO i=ii_begin,ii_end 162 ij=(j-1)*iim+i 163 uc(ij,:,l)=u fi(ij,l)*elon_i(ij,:)+vfi(ij,l)*elat_i(ij,:)202 utemp=utemp-u 203 vtemp=vtemp-v 204 205 DO l=1,llm 206 DO j=jj_begin,jj_end 207 DO i=ii_begin,ii_end 208 ij=(j-1)*iim+i 209 uc(ij,:,l)=utemp(ij,l)*elon_i(ij,:)+vtemp(ij,l)*elat_i(ij,:) 164 210 ENDDO 165 211 ENDDO 166 212 ENDDO 167 213 168 out_i=ufi214 ! out_i=ufi 169 215 170 216 DO l=1,llm … … 469 515 end do 470 516 517 IF (test==0) return 471 518 !=============================================================================== 472 519 ! Send variables to history file - THIS PROCESS WILL BE MODEL SPECIFIC
Note: See TracChangeset
for help on using the changeset viewer.