- Timestamp:
- 07/29/14 10:10:51 (10 years ago)
- Location:
- codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src
- Files:
-
- 3 added
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/caldyn_gcm.f90
r221 r260 300 300 ! f_buf_i, f_buf_v, f_buf_u3d, f_buf_ulon, f_buf_ulat, f_buf_s, f_buf_p) 301 301 CALL un2ulonlat(f_u, f_buf_ulon, f_buf_ulat) 302 CALL writefield("ulon",f_buf_ulon)303 CALL writefield("ulat",f_buf_ulat)302 CALL output_field("ulon",f_buf_ulon) 303 CALL output_field("ulat",f_buf_ulat) 304 304 305 305 CALL output_field("ps",f_ps) -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/domain.f90
r221 r260 17 17 INTEGER :: jj_end_glo 18 18 INTEGER,POINTER :: assign_domain(:,:) 19 INTEGER,POINTER :: assign_cell_glo(:,:) 19 20 INTEGER,POINTER :: assign_i(:,:) 20 21 INTEGER,POINTER :: assign_j(:,:) … … 142 143 d%face=nf 143 144 ALLOCATE(d%assign_domain(d%iim,d%jjm)) 145 ALLOCATE(d%assign_cell_glo(d%iim,d%jjm)) 144 146 ALLOCATE(d%assign_i(d%iim,d%jjm)) 145 147 ALLOCATE(d%assign_j(d%iim,d%jjm)) … … 183 185 d2%jj_end_glo = d1%jj_end_glo 184 186 d2%assign_domain => d1%assign_domain 187 d2%assign_cell_glo => d1%assign_cell_glo 185 188 d2%assign_i => d1%assign_i 186 189 d2%assign_j => d1%assign_j … … 268 271 jj=d%jj_begin_glo-d%jj_begin+j 269 272 ind=vertex_glo(ii,jj,nf)%ind 273 d%assign_cell_glo(i,j) = ind 270 274 d%assign_domain(i,j)=cell_glo(ind)%assign_domain 271 275 d%assign_i(i,j)=cell_glo(ind)%assign_i -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/etat0.f90
r221 r260 27 27 USE dynetat0_gcm_mod, ONLY : dynetat0_start=>etat0 28 28 USE dynetat0_hz_mod, ONLY : dynetat0_hz=>etat0 29 USE etat0_start_file_mod, ONLY : etat0_start_file=>etat0 29 30 30 31 IMPLICIT NONE … … 66 67 CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q) 67 68 !------------------- Old interface -------------------- 69 CASE ('start_file') 70 CALL etat0_start_file(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 68 71 CASE ('academic') 69 72 CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q) -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/field.f90
r221 r260 116 116 END SUBROUTINE allocate_field 117 117 118 SUBROUTINE allocate_field_glo(field,field_type,data_type,dim1,dim2 )118 SUBROUTINE allocate_field_glo(field,field_type,data_type,dim1,dim2,name) 119 119 USE domain_mod 120 120 IMPLICIT NONE … … 123 123 INTEGER,INTENT(IN) :: data_type 124 124 INTEGER,OPTIONAL :: dim1,dim2 125 CHARACTER(*), OPTIONAL :: name 125 126 INTEGER :: ind 126 127 INTEGER :: ii_size,jj_size … … 141 142 ENDIF 142 143 144 IF(PRESENT(name)) THEN 145 field(ind)%name = name 146 ELSE 147 field(ind)%name = '(undefined)' 148 END IF 143 149 144 150 field(ind)%data_type=data_type … … 180 186 INTEGER :: ind 181 187 188 !$OMP BARRIER 182 189 DO ind=1,ndomain 190 IF (.NOT. assigned_domain(ind)) CYCLE 183 191 184 192 data_type=field(ind)%data_type … … 199 207 200 208 ENDDO 209 !$OMP BARRIER 210 !$OMP MASTER 201 211 DEALLOCATE(field) 212 !$OMP END MASTER 213 !$OMP BARRIER 202 214 203 215 END SUBROUTINE deallocate_field -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/geometry.f90
r221 r260 83 83 IMPLICIT NONE 84 84 85 CALL allocate_field(geom%Ai,field_t,type_real )85 CALL allocate_field(geom%Ai,field_t,type_real,name='Ai') 86 86 CALL allocate_field(geom%xyz_i,field_t,type_real,3) 87 87 CALL allocate_field(geom%centroid,field_t,type_real,3) -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/physics_lmdz5.f90
r221 r260 180 180 !$OMP BARRIER 181 181 dtphy=itau_physics*dt 182 182 IF(it==itaumax) THEN 183 lafin=.TRUE. 184 ELSE 185 lafin=.FALSE. 186 ENDIF 183 187 CALL transfert_message(f_u,req_u) 184 188 offset=0 -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/physics_lmdz_generic.f90
r254 r260 231 231 ENDIF 232 232 233 IF(it==itaumax) THEN 234 lafin=.TRUE. 235 ELSE 236 lafin=.FALSE. 237 ENDIF 238 233 239 !$OMP MASTER 234 240 ! CALL update_calendar(it) -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/timeloop_gcm.f90
r221 r260 61 61 CALL allocate_field(f_theta_rhodzm1,field_t,type_real,llm,name='theta_rhodzm1') 62 62 ! Tracers 63 CALL allocate_field(f_q,field_t,type_real,llm,nqtot )63 CALL allocate_field(f_q,field_t,type_real,llm,nqtot,'q') 64 64 CALL allocate_field(f_rhodz,field_t,type_real,llm,name='rhodz') 65 65 ! Mass fluxes … … 155 155 USE xios_mod 156 156 USE output_field_mod 157 USE write_etat0_mod 157 158 IMPLICIT NONE 158 159 REAL(rstd),POINTER :: q(:,:,:) … … 170 171 INTEGER :: stop_clock 171 172 INTEGER :: rate_clock 173 174 175 ! CALL write_etat0(f_ps, f_phis,f_theta_rhodz,f_u,f_q) 176 ! CALL read_start(f_ps,f_mass,f_phis,f_theta_rhodz,f_u,f_q) 177 ! CALL write_restart(f_ps,f_mass,f_phis,f_theta_rhodz,f_u,f_q) 172 178 173 179 CALL caldyn_BC(f_phis, f_wflux) ! set constant values in first/last interfaces … … 242 248 END DO 243 249 244 IF (MOD(it +1,itau_dissip)==0) THEN250 IF (MOD(it,itau_dissip)==0) THEN 245 251 ! CALL send_message(f_ps,req_ps) 246 252 ! CALL wait_message(req_ps) … … 263 269 END IF 264 270 265 IF(MOD(it +1,itau_adv)==0) THEN271 IF(MOD(it,itau_adv)==0) THEN 266 272 267 273 CALL advect_tracer(f_hfluxt,f_wfluxt,f_u, f_q,f_rhodz) ! update q and rhodz after RK step … … 282 288 283 289 284 IF (MOD(it +1,itau_physics)==0) THEN290 IF (MOD(it,itau_physics)==0) THEN 285 291 CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q) 286 292 ENDIF 287 293 288 294 ENDDO 289 295 296 CALL write_etat0(f_ps, f_phis,f_theta_rhodz,f_u,f_q) 297 290 298 CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it) 291 299 … … 295 303 296 304 IF (mpi_rank==0) THEN 297 PRINT *,"Time elapsed : ",(stop_clock-start_clock)*1./rate_clock 305 PRINT *,"Time elapsed : ",(stop_clock-start_clock)*1./rate_clock 298 306 ENDIF 299 307 !$OMP END MASTER -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/transfert.F90
r221 r260 3 3 #ifdef CPP_USING_MPI 4 4 USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_mpi, req_i1,req_e1_vect, & 5 req_e1_scal, req_i0, req_e0_vect, req_e0_scal, request_add_point, create_request, gather_field, &5 req_e1_scal, req_i0, req_e0_vect, req_e0_scal, request_add_point, create_request, gather_field, scatter_field, & 6 6 t_message,init_message=>init_message_mpi,transfert_message=>transfert_message_mpi, & 7 7 send_message=>send_message_mpi,test_message=>test_message_mpi,wait_message=>wait_message_mpi,barrier 8 8 #else 9 9 USE transfert_mpi_mod, ONLY : init_transfert, transfert_request=>transfert_request_seq, req_i1,req_e1_vect, & 10 req_e1_scal,req_i0, req_e0_vect, req_e0_scal, request_add_point, create_request, gather_field, &10 req_e1_scal,req_i0, req_e0_vect, req_e0_scal, request_add_point, create_request, gather_field, scatter_field,& 11 11 t_message,init_message=>init_message_seq,transfert_message=>transfert_message_seq, & 12 12 send_message=>send_message_seq,test_message=>test_message_seq,wait_message=>wait_message_seq,barrier -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/transfert_mpi.f90
r221 r260 1646 1646 END SUBROUTINE gather_field 1647 1647 1648 1649 SUBROUTINE scatter_field(field_glo,field_loc) 1650 USE field_mod 1651 USE domain_mod 1652 USE mpi_mod 1653 USE mpipara 1654 IMPLICIT NONE 1655 TYPE(t_field),POINTER :: field_glo(:) 1656 TYPE(t_field),POINTER :: field_loc(:) 1657 INTEGER, ALLOCATABLE :: mpi_req(:) 1658 INTEGER, ALLOCATABLE :: status(:,:) 1659 INTEGER :: ireq,nreq 1660 INTEGER :: ind_glo,ind_loc 1661 1662 IF (.NOT. using_mpi) THEN 1663 1664 DO ind_loc=1,ndomain 1665 IF (field_loc(ind_loc)%ndim==2) field_loc(ind_loc)%rval2d=field_glo(ind_loc)%rval2d 1666 IF (field_loc(ind_loc)%ndim==3) field_loc(ind_loc)%rval3d=field_glo(ind_loc)%rval3d 1667 IF (field_loc(ind_loc)%ndim==4) field_loc(ind_loc)%rval4d=field_glo(ind_loc)%rval4d 1668 ENDDO 1669 1670 ELSE 1671 1672 nreq=ndomain 1673 IF (mpi_rank==0) nreq=nreq+ndomain_glo 1674 ALLOCATE(mpi_req(nreq)) 1675 ALLOCATE(status(MPI_STATUS_SIZE,nreq)) 1676 1677 1678 ireq=0 1679 IF (mpi_rank==0) THEN 1680 DO ind_glo=1,ndomain_glo 1681 ireq=ireq+1 1682 1683 IF (field_glo(ind_glo)%ndim==2) THEN 1684 CALL MPI_ISEND(field_glo(ind_glo)%rval2d,size(field_glo(ind_glo)%rval2d) , MPI_REAL8 , & 1685 domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 1686 1687 ELSE IF (field_glo(ind_glo)%ndim==3) THEN 1688 CALL MPI_ISEND(field_glo(ind_glo)%rval3d,size(field_glo(ind_glo)%rval3d) , MPI_REAL8 , & 1689 domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 1690 1691 ELSE IF (field_glo(ind_glo)%ndim==4) THEN 1692 CALL MPI_ISEND(field_glo(ind_glo)%rval4d,size(field_glo(ind_glo)%rval4d) , MPI_REAL8 , & 1693 domglo_rank(ind_glo),domglo_loc_ind(ind_glo), comm_icosa, mpi_req(ireq), ierr) 1694 ENDIF 1695 1696 ENDDO 1697 ENDIF 1698 1699 DO ind_loc=1,ndomain 1700 ireq=ireq+1 1701 1702 IF (field_loc(ind_loc)%ndim==2) THEN 1703 CALL MPI_IRECV(field_loc(ind_loc)%rval2d,size(field_loc(ind_loc)%rval2d) , MPI_REAL8 , & 1704 0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 1705 ELSE IF (field_loc(ind_loc)%ndim==3) THEN 1706 CALL MPI_IRECV(field_loc(ind_loc)%rval3d,size(field_loc(ind_loc)%rval3d) , MPI_REAL8 , & 1707 0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 1708 ELSE IF (field_loc(ind_loc)%ndim==4) THEN 1709 CALL MPI_IRECV(field_loc(ind_loc)%rval4d,size(field_loc(ind_loc)%rval4d) , MPI_REAL8 , & 1710 0, ind_loc, comm_icosa, mpi_req(ireq), ierr) 1711 ENDIF 1712 1713 ENDDO 1714 1715 CALL MPI_WAITALL(nreq,mpi_req,status,ierr) 1716 1717 ENDIF 1718 1719 END SUBROUTINE scatter_field 1720 1721 1648 1722 1649 1723 SUBROUTINE trace_in -
codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/wind.f90
r221 r260 24 24 END SUBROUTINE un2ulonlat 25 25 26 SUBROUTINE ulonlat2un(f_ulon, f_ulat,f_u) 27 USE icosa 28 IMPLICIT NONE 29 TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! IN : velocity reconstructed at hexagons 30 TYPE(t_field), POINTER :: f_u(:) ! OUT : normal velocity components on edges 31 32 REAL(rstd),POINTER :: u(:,:), ulon(:,:), ulat(:,:) 33 INTEGER :: ind 34 35 DO ind=1,ndomain 36 IF (.NOT. assigned_domain(ind)) CYCLE 37 CALL swap_dimensions(ind) 38 CALL swap_geometry(ind) 39 u=f_u(ind) 40 ulon=f_ulon(ind) 41 ulat=f_ulat(ind) 42 CALL compute_ulonlat2un(ulon, ulat,u) 43 END DO 44 45 END SUBROUTINE ulonlat2un 26 46 27 47 SUBROUTINE compute_wind_centered(ue,ucenter) … … 298 318 END SUBROUTINE compute_wind_centered_lonlat_compound 299 319 320 SUBROUTINE compute_wind_centered_from_wind_lonlat_centered(ulon, ulat,uc) 321 USE icosa 322 323 IMPLICIT NONE 324 REAL(rstd) :: ulon(iim*jjm,llm) 325 REAL(rstd) :: ulat(iim*jjm,llm) 326 REAL(rstd) :: uc(iim*jjm,3,llm) 327 328 INTEGER :: i,j,ij,l 329 330 331 DO l=1,llm 332 DO j=jj_begin,jj_end 333 DO i=ii_begin,ii_end 334 ij=(j-1)*iim+i 335 uc(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ulat(ij,l)*elat_i(ij,:) 336 ENDDO 337 ENDDO 338 ENDDO 339 340 END SUBROUTINE compute_wind_centered_from_wind_lonlat_centered 341 342 343 344 SUBROUTINE compute_wind_perp_from_wind_centered(uc,un) 345 USE icosa 346 347 IMPLICIT NONE 348 REAL(rstd),INTENT(IN) :: uc(iim*jjm,3,llm) 349 REAL(rstd),INTENT(OUT) :: un(3*iim*jjm,llm) 350 351 INTEGER :: i,j,ij,l 352 353 354 DO l=1,llm 355 DO j=jj_begin,jj_end 356 DO i=ii_begin,ii_end 357 ij=(j-1)*iim+i 358 un(ij+u_right,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:)) 359 un(ij+u_lup,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:)) 360 un(ij+u_ldown,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:)) 361 ENDDO 362 ENDDO 363 ENDDO 364 365 END SUBROUTINE compute_wind_perp_from_wind_centered 366 367 300 368 SUBROUTINE compute_un2ulonlat(un, ulon, ulat) 301 369 USE icosa … … 313 381 END SUBROUTINE compute_un2ulonlat 314 382 383 SUBROUTINE compute_ulonlat2un(ulon, ulat,un) 384 USE icosa 385 386 IMPLICIT NONE 387 REAL(rstd),INTENT(IN) :: ulon(iim*jjm,llm) 388 REAL(rstd),INTENT(IN) :: ulat(iim*jjm,llm) 389 REAL(rstd),INTENT(OUT) :: un(3*iim*jjm,llm) 390 391 REAL(rstd) :: uc(iim*jjm,3,llm) 392 393 CALL compute_wind_centered_from_wind_lonlat_centered(ulon, ulat, uc) 394 CALL compute_wind_perp_from_wind_centered(uc, un) 395 396 END SUBROUTINE compute_ulonlat2un 397 398 315 399 END MODULE wind_mod
Note: See TracChangeset
for help on using the changeset viewer.