Ignore:
Timestamp:
07/29/14 10:10:51 (10 years ago)
Author:
ymipsl
Message:

Implement restartability for dynamico

YM

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  
    300300!            f_buf_i, f_buf_v, f_buf_u3d, f_buf_ulon, f_buf_ulat, f_buf_s, f_buf_p) 
    301301       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) 
    304304 
    305305       CALL output_field("ps",f_ps) 

  • codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/domain.f90

    r221 r260  
    1717    INTEGER :: jj_end_glo 
    1818    INTEGER,POINTER  :: assign_domain(:,:) 
     19    INTEGER,POINTER  :: assign_cell_glo(:,:) 
    1920    INTEGER,POINTER  :: assign_i(:,:) 
    2021    INTEGER,POINTER  :: assign_j(:,:) 
    … …  
    142143          d%face=nf         
    143144          ALLOCATE(d%assign_domain(d%iim,d%jjm)) 
     145          ALLOCATE(d%assign_cell_glo(d%iim,d%jjm)) 
    144146          ALLOCATE(d%assign_i(d%iim,d%jjm)) 
    145147          ALLOCATE(d%assign_j(d%iim,d%jjm)) 
    … …  
    183185    d2%jj_end_glo = d1%jj_end_glo 
    184186    d2%assign_domain => d1%assign_domain 
     187    d2%assign_cell_glo => d1%assign_cell_glo 
    185188    d2%assign_i => d1%assign_i 
    186189    d2%assign_j => d1%assign_j 
    … …  
    268271          jj=d%jj_begin_glo-d%jj_begin+j 
    269272          ind=vertex_glo(ii,jj,nf)%ind 
     273          d%assign_cell_glo(i,j) = ind   
    270274          d%assign_domain(i,j)=cell_glo(ind)%assign_domain 
    271275          d%assign_i(i,j)=cell_glo(ind)%assign_i 

  • codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/etat0.f90

    r221 r260  
    2727    USE dynetat0_gcm_mod, ONLY : dynetat0_start=>etat0  
    2828    USE dynetat0_hz_mod,  ONLY : dynetat0_hz=>etat0  
     29    USE etat0_start_file_mod, ONLY : etat0_start_file=>etat0   
    2930 
    3031    IMPLICIT NONE 
    … …  
    6667       CALL etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q) 
    6768       !------------------- Old interface -------------------- 
     69    CASE ('start_file') 
     70       CALL etat0_start_file(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 
    6871    CASE ('academic') 
    6972       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  
    116116  END SUBROUTINE allocate_field 
    117117 
    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) 
    119119  USE domain_mod 
    120120  IMPLICIT NONE 
    … …  
    123123    INTEGER,INTENT(IN) :: data_type 
    124124    INTEGER,OPTIONAL :: dim1,dim2 
     125    CHARACTER(*), OPTIONAL :: name 
    125126    INTEGER :: ind 
    126127    INTEGER :: ii_size,jj_size 
    … …  
    141142      ENDIF 
    142143     
     144      IF(PRESENT(name)) THEN 
     145         field(ind)%name = name 
     146      ELSE 
     147         field(ind)%name = '(undefined)' 
     148      END IF 
    143149     
    144150      field(ind)%data_type=data_type 
    … …  
    180186    INTEGER :: ind 
    181187 
     188!$OMP BARRIER 
    182189    DO ind=1,ndomain 
     190      IF (.NOT. assigned_domain(ind)) CYCLE 
    183191 
    184192      data_type=field(ind)%data_type 
    … …  
    199207       
    200208   ENDDO 
     209!$OMP BARRIER 
     210!$OMP MASTER 
    201211   DEALLOCATE(field) 
     212!$OMP END MASTER 
     213!$OMP BARRIER 
    202214        
    203215  END SUBROUTINE deallocate_field 

  • codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/geometry.f90

    r221 r260  
    8383  IMPLICIT NONE 
    8484   
    85     CALL allocate_field(geom%Ai,field_t,type_real) 
     85    CALL allocate_field(geom%Ai,field_t,type_real,name='Ai') 
    8686    CALL allocate_field(geom%xyz_i,field_t,type_real,3) 
    8787    CALL allocate_field(geom%centroid,field_t,type_real,3) 

  • codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/physics_lmdz5.f90

    r221 r260  
    180180!$OMP BARRIER 
    181181    dtphy=itau_physics*dt 
    182      
     182    IF(it==itaumax) THEN  
     183      lafin=.TRUE. 
     184    ELSE  
     185      lafin=.FALSE. 
     186    ENDIF 
    183187    CALL transfert_message(f_u,req_u) 
    184188    offset=0 

  • codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/physics_lmdz_generic.f90

    r254 r260  
    231231    ENDIF 
    232232 
     233    IF(it==itaumax) THEN  
     234      lafin=.TRUE. 
     235    ELSE  
     236      lafin=.FALSE. 
     237    ENDIF 
     238 
    233239!$OMP MASTER         
    234240!    CALL update_calendar(it) 

  • codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/timeloop_gcm.f90

    r221 r260  
    6161    CALL allocate_field(f_theta_rhodzm1,field_t,type_real,llm,name='theta_rhodzm1') 
    6262! 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') 
    6464    CALL allocate_field(f_rhodz,field_t,type_real,llm,name='rhodz') 
    6565! Mass fluxes 
    … …  
    155155  USE xios_mod 
    156156  USE output_field_mod 
     157  USE write_etat0_mod 
    157158  IMPLICIT NONE   
    158159    REAL(rstd),POINTER :: q(:,:,:) 
    … …  
    170171    INTEGER :: stop_clock 
    171172    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)  
    172178     
    173179    CALL caldyn_BC(f_phis, f_wflux) ! set constant values in first/last interfaces 
    … …  
    242248    END DO 
    243249 
    244     IF (MOD(it+1,itau_dissip)==0) THEN 
     250    IF (MOD(it,itau_dissip)==0) THEN 
    245251!         CALL send_message(f_ps,req_ps) 
    246252!         CALL wait_message(req_ps)   
    … …  
    263269    END IF 
    264270 
    265     IF(MOD(it+1,itau_adv)==0) THEN 
     271    IF(MOD(it,itau_adv)==0) THEN 
    266272 
    267273       CALL advect_tracer(f_hfluxt,f_wfluxt,f_u, f_q,f_rhodz)  ! update q and rhodz after RK step 
    … …  
    282288 
    283289 
    284     IF (MOD(it+1,itau_physics)==0) THEN 
     290    IF (MOD(it,itau_physics)==0) THEN 
    285291      CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q) 
    286292    ENDIF 
    287293     
    288294  ENDDO 
    289       
     295 
     296  CALL write_etat0(f_ps, f_phis,f_theta_rhodz,f_u,f_q)  
     297 
    290298  CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)   
    291299 
    … …  
    295303     
    296304  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  
    298306  ENDIF   
    299307!$OMP END MASTER  

  • codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/transfert.F90

    r221 r260  
    33#ifdef CPP_USING_MPI 
    44  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, & 
    66                                t_message,init_message=>init_message_mpi,transfert_message=>transfert_message_mpi,  & 
    77                                send_message=>send_message_mpi,test_message=>test_message_mpi,wait_message=>wait_message_mpi,barrier 
    88#else  
    99  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,& 
    1111                                t_message,init_message=>init_message_seq,transfert_message=>transfert_message_seq,  & 
    1212                                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  
    16461646  END SUBROUTINE gather_field 
    16471647 
     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 
    16481722    
    16491723  SUBROUTINE trace_in 

  • codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/wind.f90

    r221 r260  
    2424  END SUBROUTINE un2ulonlat 
    2525 
     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 
    2646  
    2747  SUBROUTINE compute_wind_centered(ue,ucenter) 
    … …  
    298318 END SUBROUTINE compute_wind_centered_lonlat_compound 
    299319 
     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 
    300368 SUBROUTINE compute_un2ulonlat(un, ulon, ulat) 
    301369  USE icosa   
    … …  
    313381 END SUBROUTINE compute_un2ulonlat 
    314382 
     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 
    315399END MODULE wind_mod 
Note: See TracChangeset for help on using the changeset viewer.