- Timestamp:
- 07/18/12 11:15:39 (12 years ago)
- Location:
- codes/icosagcm/trunk/src
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/caldyn_gcm.f90
r19 r21 112 112 REAL(rstd),POINTER :: dtheta_rhodz(:,:) 113 113 REAL(rstd),POINTER :: du(:,:) 114 INTEGER :: ind 114 INTEGER :: ind,ij 115 115 116 116 … … 119 119 CALL transfert_request(f_theta_rhodz,req_i1) 120 120 CALL transfert_request(f_u,req_e1) 121 CALL transfert_request(f_u,req_e1)121 ! CALL transfert_request(f_u,req_e1) 122 122 123 123 … … 136 136 dtheta_rhodz=f_dtheta_rhodz(ind) 137 137 du=f_du(ind) 138 138 ! ij=(jj_end-1-1)*iim+ii_begin 139 ! PRINT *,"--> ind=",ind,ij 140 ! PRINT *,u(ij+u_right,1) 141 ! PRINT *,u(ij+u_rup,1) 142 ! PRINT *,u(ij+u_lup,1) 143 ! PRINT *,u(ij+u_left,1) 144 ! PRINT *,u(ij+u_ldown,1) 145 ! PRINT *,u(ij+u_rdown,1) 146 147 ! ij=(jj_end-1-1)*iim+ii_end 148 ! PRINT *,"--> ind=",ind,ij 149 ! PRINT *,u(ij+u_right,1) 150 ! PRINT *,u(ij+u_rup,1) 151 ! PRINT *,u(ij+u_lup,1) 152 ! PRINT *,u(ij+u_left,1) 153 ! PRINT *,u(ij+u_ldown,1) 154 ! PRINT *,u(ij+u_rdown,1) 139 155 !$OMP PARALLEL DEFAULT(SHARED) 140 156 CALL compute_caldyn(phis, ps, theta_rhodz, u, dps, dtheta_rhodz, du) … … 143 159 144 160 CALL transfert_request(f_out_u,req_e1) 145 CALL transfert_request(f_out_u,req_e1)161 ! CALL transfert_request(f_out_u,req_e1) 146 162 147 163 ! CALL vorticity(f_u,f_out_z) 148 ! CALL kinetic(f_du,f_out)149 164 150 165 IF (mod(it,itau_out)==0 ) THEN 151 166 CALL writefield("ps",f_ps) 152 !CALL writefield("dps",f_dps)167 CALL writefield("dps",f_dps) 153 168 ! CALL writefield("theta_rhodz",f_theta_rhodz) 169 ! CALL kinetic(f_u,f_out) 170 ! CALL writefield("Ki",f_out) 154 171 ! CALL writefield("dtheta_rhodz",f_dtheta_rhodz) 155 172 CALL vorticity(f_u,f_out_z) … … 163 180 ! CALL writefield("Ki",f_out,ind) 164 181 ! CALL writefield("vort",f_out_z,ind) 182 ! CALL writefield("dps",f_dps,ind) 165 183 ! ENDDO 166 184 -
codes/icosagcm/trunk/src/domain.f90
r15 r21 19 19 INTEGER,POINTER :: assign_i(:,:) 20 20 INTEGER,POINTER :: assign_j(:,:) 21 INTEGER,POINTER :: edge_assign_domain(:,:,:) 22 INTEGER,POINTER :: edge_assign_i(:,:,:) 23 INTEGER,POINTER :: edge_assign_j(:,:,:) 24 INTEGER,POINTER :: edge_assign_pos(:,:,:) 21 25 REAL,POINTER :: xyz(:,:,:) 22 26 REAL,POINTER :: neighbour(:,:,:,:) … … 71 75 ind=0 72 76 DO nf=1,nb_face 73 DO nj=1,nsplit_ i74 DO ni=1,nsplit_ j77 DO nj=1,nsplit_j 78 DO ni=1,nsplit_i 75 79 ind=ind+1 76 80 d=>domain(ind) … … 85 89 ENDIF 86 90 d%ii_end_glo=d%ii_begin_glo+d%ii_nb-1 91 92 IF (ni/=nsplit_i) THEN 93 d%ii_nb=d%ii_nb+1 94 d%ii_end_glo=d%ii_end_glo+1 95 ENDIF 96 87 97 88 98 quotient=(jjm_glo/nsplit_j) … … 95 105 d%jj_begin_glo=(quotient+1)*rest+(nj-1-rest) * quotient+1 96 106 ENDIF 97 98 107 d%jj_end_glo=d%jj_begin_glo+d%jj_nb-1 108 109 IF (nj/=nsplit_j) THEN 110 d%jj_nb=d%jj_nb+1 111 d%jj_end_glo=d%jj_end_glo+1 112 ENDIF 113 114 99 115 d%iim=d%ii_nb+2*halo 100 116 d%jjm=d%jj_nb+2*halo … … 107 123 ALLOCATE(d%assign_i(d%iim,d%jjm)) 108 124 ALLOCATE(d%assign_j(d%iim,d%jjm)) 125 ALLOCATE(d%edge_assign_domain(0:5,d%iim,d%jjm)) 126 ALLOCATE(d%edge_assign_i(0:5,d%iim,d%jjm)) 127 ALLOCATE(d%edge_assign_j(0:5,d%iim,d%jjm)) 128 ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm)) 109 129 ALLOCATE(d%delta(d%iim,d%jjm)) 110 130 ALLOCATE(d%xyz(3,d%iim,d%jjm)) … … 123 143 USE metric 124 144 IMPLICIT NONE 125 INTEGER :: ind_d,ind,ind2 145 INTEGER :: ind_d,ind,ind2,e 126 146 INTEGER :: nf 127 147 INTEGER :: i,j,k,ii,jj 128 148 TYPE(t_domain),POINTER :: d 149 INTEGER :: delta 129 150 130 151 … … 137 158 jj=d%jj_begin_glo-d%jj_begin+j 138 159 ind=vertex_glo(ii,jj,nf)%ind 160 delta=vertex_glo(ii,jj,nf)%delta 139 161 IF (cell_glo(ind)%assign_face==nf) THEN 140 162 cell_glo(ind)%assign_domain=ind_d … … 142 164 cell_glo(ind)%assign_j=j 143 165 ENDIF 166 IF ( i+1 <= d%ii_end ) CALL assign_edge(ind_d,ind,i,j,delta,0) 167 IF ( j+1 <= d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,1) 168 IF ( i-1 >= d%ii_begin .AND. j+1<=d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,2) 169 IF ( i-1 >= d%ii_begin ) CALL assign_edge(ind_d,ind,i,j,delta,3) 170 IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4) 171 IF ( i+1 <= d%ii_end .AND. j-1 >=d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,5) 144 172 ENDDO 145 173 ENDDO 146 174 ENDDO 175 147 176 148 177 DO ind_d=1,ndomain … … 157 186 d%assign_i(i,j)=cell_glo(ind)%assign_i 158 187 d%assign_j(i,j)=cell_glo(ind)%assign_j 188 delta=vertex_glo(ii,jj,nf)%delta 159 189 d%delta(i,j)=vertex_glo(ii,jj,nf)%delta 160 190 DO k=0,5 … … 162 192 d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:) 163 193 d%ne(k,i,j)=vertex_glo(ii,jj,nf)%ne(k) 194 e=cell_glo(ind)%edge(MOD(k+delta+6,6)) 195 d%edge_assign_domain(k,i,j)=edge_glo(e)%assign_domain 196 d%edge_assign_i(k,i,j)=edge_glo(e)%assign_i 197 d%edge_assign_j(k,i,j)=edge_glo(e)%assign_j 198 d%edge_assign_pos(k,i,j)=edge_glo(e)%assign_pos 164 199 ENDDO 165 200 d%xyz(:,i,j)=cell_glo(ind)%xyz(:) … … 171 206 ENDDO 172 207 ENDDO 173 ENDDO 208 ENDDO 209 210 CONTAINS 211 212 SUBROUTINE assign_edge(ind_d,ind,i,j,delta,k) 213 INTEGER :: ind_d,ind,i,j,delta,k 214 INTEGER :: e 215 e=cell_glo(ind)%edge(MOD(k+delta+6,6)) 216 edge_glo(e)%assign_domain=ind_d 217 edge_glo(e)%assign_i=i 218 edge_glo(e)%assign_j=j 219 edge_glo(e)%assign_pos=k 220 ! PRINT*,"Assign_edge",ind_d,ind,i,j,k,e 221 END SUBROUTINE assign_edge 222 174 223 END SUBROUTINE assign_cell 175 224 -
codes/icosagcm/trunk/src/geometry.f90
r17 r21 257 257 REAL(rstd) :: surf_v(6) 258 258 REAL(rstd) :: vect(3,6) 259 REAL(rstd) :: centr( 6)259 REAL(rstd) :: centr(3) 260 260 REAL(rstd) :: vet(3),vep(3) 261 261 INTEGER :: ind,i,j,k,n -
codes/icosagcm/trunk/src/metric.f90
r15 r21 25 25 INTEGER :: e1 26 26 INTEGER :: e2 27 INTEGER :: assign_domain 28 INTEGER :: assign_i 29 INTEGER :: assign_j 30 INTEGER :: assign_pos 27 31 END TYPE t_edge_glo 28 32 -
codes/icosagcm/trunk/src/timeloop_gcm.f90
r19 r21 90 90 CALL init_caldyn(dt) 91 91 CALL init_guided(dt) 92 CALL init_advect_tracer(dt)92 ! CALL init_advect_tracer(dt) 93 93 94 94 CALL etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q) … … 99 99 CALL guided(it,f_ps,f_theta_rhodz,f_u,f_q) 100 100 CALL caldyn(it,f_phis,f_ps,f_theta_rhodz,f_u, f_dps, f_dtheta_rhodz, f_du) 101 CALL advect_tracer(f_ps,f_u,f_q)101 ! CALL advect_tracer(f_ps,f_u,f_q) 102 102 103 103 SELECT CASE (TRIM(scheme)) … … 116 116 117 117 CASE default 118 PRINT*,'Bad selector for variable scheme : <', TRIM(scheme),"> options are <euler>, <leapfrog>, <leapfrog_matsuno>, <adam_bashforth>" 118 PRINT*,'Bad selector for variable scheme : <', TRIM(scheme), & 119 ' > options are <euler>, <leapfrog>, <leapfrog_matsuno>, <adam_bashforth>' 119 120 STOP 120 121 -
codes/icosagcm/trunk/src/transfert.f90
r15 r21 227 227 ELSE IF (req%type_field==field_u) THEN 228 228 IF (.NOT. PRESENT(pos)) STOP 'argument request_add_point non conforme' 229 230 src_domain=domain(ind)% assign_domain(i,j)229 230 src_domain=domain(ind)%edge_assign_domain(pos-1,i,j) 231 231 src_iim=domain(src_domain)%iim 232 src_i=domain(ind)% assign_i(i,j)233 src_j=domain(ind)% assign_j(i,j)232 src_i=domain(ind)%edge_assign_i(pos-1,i,j) 233 src_j=domain(ind)%edge_assign_j(pos-1,i,j) 234 234 src_n=(src_j-1)*src_iim+src_i 235 235 src_delta=domain(ind)%delta(i,j) 236 236 237 src_pos=MOD(pos-1+src_delta+6,6)+1 238 237 ! src_pos=MOD(pos-1+src_delta+6,6)+1 238 src_pos=domain(ind)%edge_assign_pos(pos-1,i,j)+1 239 239 240 req%target_ind(req%size)=(j-1)*d%iim+i+d%u_pos(pos) 240 241 req%src_domain(req%size)=src_domain 241 242 req%src_ind(req%size)=src_n+domain(src_domain)%u_pos(src_pos) 242 243 243 req%target_i(req%size)=i 244 req%target_j(req%size)=j 245 req%src_i(req%size)=domain(ind)%assign_i(i,j) 246 req%src_j(req%size)=domain(ind)%assign_j(i,j) 247 248 ! PRINT *,ind,i,j,"src_delta",src_delta 244 ! req%target_i(req%size)=i 245 ! req%target_j(req%size)=j 246 ! req%src_i(req%size)=domain(ind)%assign_i(i,j) 247 ! req%src_j(req%size)=domain(ind)%assign_j(i,j) 248 249 ! PRINT *,"1--->",ind,i,j,pos 250 ! PRINT *,"2--->",src_domain,src_i,src_j,src_pos 249 251 250 252 ELSE IF (req%type_field==field_z) THEN -
codes/icosagcm/trunk/src/wind.f90
r19 r21 18 18 DO i=ii_begin,ii_end 19 19 ij=(j-1)*iim+i 20 ucenter(ij,:,l)=1/Ai(ij)*( ne(ij,right)*ue(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_i(ij+z_rup,:))/2 -centroid(ij,:)) & 21 + ne(ij,rup)*ue(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_i(ij+z_up,:))/2-centroid(ij,:)) & 22 + ne(ij,lup)*ue(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_i(ij+z_lup,:))/2-centroid(ij,:)) & 23 + ne(ij,left)*ue(ij+u_left,l)*le(ij+u_left)*((xyz_i(ij+z_lup,:)+xyz_i(ij+z_ldown,:))/2-centroid(ij,:)) & 24 + ne(ij,ldown)*ue(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_i(ij+z_ldown,:)+xyz_i(ij+z_down,:))/2-centroid(ij,:)) & 25 + ne(ij,rdown)*ue(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_i(ij+z_down,:)+xyz_i(ij+z_rdown,:))/2-centroid(ij,:)) ) 20 ucenter(ij,:,l)=1/Ai(ij)* & 21 ( ne(ij,right)*ue(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_i(ij+z_rup,:))/2 -centroid(ij,:))& 22 + ne(ij,rup)*ue(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_i(ij+z_up,:))/2-centroid(ij,:)) & 23 + ne(ij,lup)*ue(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_i(ij+z_lup,:))/2-centroid(ij,:)) & 24 + ne(ij,left)*ue(ij+u_left,l)*le(ij+u_left)*((xyz_i(ij+z_lup,:)+xyz_i(ij+z_ldown,:))/2-centroid(ij,:)) & 25 + ne(ij,ldown)*ue(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_i(ij+z_ldown,:)+xyz_i(ij+z_down,:))/2-centroid(ij,:))& 26 + ne(ij,rdown)*ue(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_i(ij+z_down,:)+xyz_i(ij+z_rdown,:))/2-centroid(ij,:))) 26 27 ENDDO 27 28 ENDDO -
codes/icosagcm/trunk/src/write_field.f90
r17 r21 154 154 ENDDO 155 155 ENDDO 156 status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 156 status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d, & 157 start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 157 158 DEALLOCATE(field_val2d) 158 159 ELSE IF (field(ind)%ndim==3) THEN … … 238 239 ENDDO 239 240 240 status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 241 status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1), & 242 Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /)) 241 243 DEALLOCATE(field_val2d) 242 244 … … 397 399 ELSE IF (Field(ind_b)%ndim==4) THEN 398 400 DO i=1,FieldVarId(NbField)%size 399 status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(i)) 401 status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /), & 402 FieldVarId(NbField)%nc_id(i)) 400 403 status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat") 401 404 ENDDO … … 504 507 ELSE IF (Field(ind_b)%ndim==4) THEN 505 508 DO q=1,FieldVarId(NbField)%size 506 status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q)) 509 status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE, & 510 (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q)) 507 511 status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat") 508 512 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.