Changeset 992 for codes

Timestamp:

11/15/19 10:57:42 (5 years ago)

Author:

rpennel

Message:

devel : add reading metrics from file at init (folllowing revs @882, @887, @888)

[ !! needs to rewrite new subroutine in xios_mod using cellset strcuture ]

Location:

codes/icosagcm/devel/src

Files:

• base/signature.f90 (added)
• icosa_init.f90 (modified) (2 diffs)
• output/write_etat0.f90 (modified) (3 diffs)
• output/xios_mod.F90 (modified) (10 diffs)
• read_metric.f90 (added)

codes/icosagcm/devel/src/icosa_init.f90

@@ -23 +23 @@
   USE diagflux_mod
   USE profiling_mod
+  USE read_metric_mod
   USE init_grid_param_mod
   USE compute_geometry_mod
+  !USE xios
   IMPLICIT NONE
   
@@ -43 +45 @@
   !$OMP PARALLEL  
     CALL switch_omp_no_distrib_level
+    CALL read_metric
     CALL compute_geometry
     CALL check_total_area

codes/icosagcm/devel/src/output/write_etat0.f90

@@ -26 +26 @@
     TYPE(t_field),POINTER,SAVE :: f_ulat(:)
     TYPE(t_field),POINTER,SAVE :: f_theta_rhodz_1d(:)
+    TYPE(t_field),POINTER,SAVE :: f_xcell(:),f_ycell(:),f_zcell(:)
     REAL(rstd), POINTER :: theta_rhodz(:,:,:),theta_rhodz_1d(:,:)
+    REAL(rstd), POINTER :: xcell(:), ycell(:), zcell(:)
     INTEGER :: ind
     
@@ -34 +36 @@
     CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat')
     CALL allocate_field(f_theta_rhodz_1d,field_t,type_real,llm,name='theta_rhodz')
+    CALL allocate_field(f_xcell,field_t,type_real,name='xcell')
+    CALL allocate_field(f_ycell,field_t,type_real,name='ycell')
+    CALL allocate_field(f_zcell,field_t,type_real,name='zcell')
 
 !$OMP BARRIER    
     DO ind=1, ndomain
        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
        theta_rhodz=f_theta_rhodz(ind) ; theta_rhodz_1d=f_theta_rhodz_1d(ind)
        theta_rhodz_1d(:,:)=theta_rhodz(:,:,1)
+       xcell=f_xcell(ind) ; xcell=xyz_i(:,1)/radius
+       ycell=f_ycell(ind) ; ycell=xyz_i(:,2)/radius
+       zcell=f_zcell(ind) ; zcell=xyz_i(:,3)/radius
     ENDDO
     
@@ -46 +56 @@
 
     IF(hydrostatic) THEN
-       CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q)
+       CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q, f_xcell, f_ycell, f_zcell )
     ELSE
-       CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q, f_geopot, f_W)
+       CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q, f_geopot, f_W, f_xcell, f_ycell, f_zcell)
     END IF
     CALL deallocate_field(f_ulon)

codes/icosagcm/devel/src/output/xios_mod.F90

@@ -19 +19 @@
 
   PUBLIC :: using_xios, xios_init, &
-       xios_init_write_field,  xios_write_field_finalize, &
+       xios_init_write_field, xios_init_write_field_input, &
+       xios_write_field_finalize, &
        xios_write_field, xios_read_field
 
@@ -28 +29 @@
        xios_set_filegroup_attr, xios_get_axis_attr, &
        xios_send_field, xios_read_var, &
-       xios_update_calendar, xios_set_context
+       xios_update_calendar, xios_set_context, xios_set_context_input
   
 CONTAINS
@@ -38 +39 @@
    using_xios=.TRUE.
    CALL xios_context_initialize("icosagcm",comm_icosa)
-   CALL xios_get_handle("icosagcm",ctx_hdl)
-   CALL xios_set_current_context(ctx_hdl)   
+   CALL xios_context_initialize("icosagcm_input",comm_icosa)
+   CALL xios_set_context
 
  END SUBROUTINE xios_init
@@ -59 +60 @@
    TYPE(t_domain),POINTER :: d
    
+   CALL xios_set_context
    !$OMP BARRIER
    !$OMP MASTER
    !   CALL xios_context_initialize("icosagcm",comm_icosa)
-   CALL xios_get_handle("icosagcm",ctx_hdl)
-   CALL xios_set_current_context(ctx_hdl)
+   !   CALL xios_get_handle("icosagcm",ctx_hdl)
+   !   CALL xios_set_current_context(ctx_hdl)
    lev_value(:) = (/ (l,l=1,llm) /)     
    lev_valuep1(:) = (/ (l,l=1,llm+1) /)     
@@ -140 +142 @@
  END SUBROUTINE xios_init_write_field
  
+ SUBROUTINE xios_init_write_field_input
+   USE disvert_mod,        ONLY : presnivs
+   USE time_mod,           ONLY : dt, itau_out
+   USE grid_param,         ONLY : llm, nqtot
+   USE mpi_mod,            ONLY : MPI_INTEGER
+   USE icosa,              ONLY : getin
+   USE mpipara,            ONLY : comm_icosa, mpi_rank, mpi_size
+   USE spherical_geom_mod, ONLY : xyz2lonlat
+   USE genmod
+ !USE genmod
+ !USE mpipara
+ !USE xios
+ !USE grid_param
+ !USE domain_mod
+ !USE dimensions
+ !USE spherical_geom_mod
+ !USE geometry
+ !USE mpi_mod
+ !USE time_mod
+ !USE metric, ONLY : vup,vdown, cell_glo
+ !USE icosa,ONLY  : getin
+ !IMPLICIT NONE
+  TYPE(xios_context) :: ctx_hdl
+  TYPE(xios_duration)      :: dtime
+  INTEGER :: ncell, ncell_tot, ncell_glo(0:mpi_size-1), displ
+  INTEGER :: ind, i,j,k,l,ij, ierr
+  REAL(rstd),ALLOCATABLE    :: lon(:), lat(:), bounds_lon(:,:), bounds_lat(:,:)
+  INTEGER, ALLOCATABLE      :: ind_glo(:)
+  TYPE(t_domain),POINTER :: d
+  CHARACTER(len=255) :: etat0_type
+  LOGICAL :: read_metric_
+
+   CALL xios_set_context_input
+!$OMP BARRIER
+!$OMP MASTER
+   
+   ncell=0
+   DO ind=1,ndomain
+     d=>domain(ind)
+        
+     DO j=d%jj_begin,d%jj_end
+       DO i=d%ii_begin,d%ii_end
+         IF (domain(ind)%own(i,j)) ncell=ncell+1
+       ENDDO
+     ENDDO
+   ENDDO      
+   ncell_i=ncell
+   
+   CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
+
+   displ=0
+   DO i=1,mpi_rank
+     displ=displ+ncell_glo(i-1)
+   ENDDO
+
+   ncell_tot=sum(ncell_glo(:))
+   
+   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:5,ncell), bounds_lat(0:5,ncell), ind_glo(ncell)) 
+   
+   ncell=0
+   DO ind=1,ndomain
+     d=>domain(ind)
+        
+     DO j=d%jj_begin,d%jj_end
+       DO i=d%ii_begin,d%ii_end
+         IF (domain(ind)%own(i,j)) THEN 
+           ncell=ncell+1
+           CALL xyz2lonlat(d%xyz(:,i,j),lon(ncell),lat(ncell))
+           lon(ncell)=lon(ncell)*180/Pi
+           lat(ncell)=lat(ncell)*180/Pi
+           DO k=0,5
+             CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ncell), bounds_lat(k,ncell))
+             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
+             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
+           ENDDO
+           ind_glo(ncell)=domain(ind)%assign_cell_glo(i,j)-1 
+         ENDIF
+       ENDDO
+     ENDDO
+   ENDDO         
+
+   CALL xios_set_domain_attr("i",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
+   CALL xios_set_domain_attr("i", data_dim=1, type='unstructured' , nvertex=6, i_index=ind_glo)
+   CALL xios_set_domain_attr("i",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
+   
+   DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo) 
+
+   dtime%second=1
+   CALL xios_set_timestep(dtime)
+!$OMP END MASTER
+
+   CALL getin('etat0',etat0_type)
+   CALL getin('read_metric', read_metric_) 
+
+!$OMP MASTER
+  
+   CALL xios_set_file_attr('start', enabled=.FALSE.)
+   IF (TRIM(etat0_type)=='start_file' .AND. read_metric_) THEN
+     CALL xios_set_file_attr('start', enabled=.TRUE.)
+   ENDIF
+     
+
+   CALL xios_close_context_definition()
+!$OMP END MASTER
+!$OMP BARRIER
+   
+ END SUBROUTINE xios_init_write_field_input 
+
+
+
  SUBROUTINE xios_write_field(name,field)
    CHARACTER(LEN=*),INTENT(IN) :: name
@@ -172 +284 @@
       
  END SUBROUTINE xios_write_field
+
+
 
  SUBROUTINE xios_read_field(name,field)
@@ -258 +372 @@
 SUBROUTINE xios_read_field_hex(name, field, cells, ncell_tot, nlev, nq)
    CHARACTER(LEN=*),INTENT(IN) :: name
-   TYPE(t_field) :: field(:)
+   TYPE(t_field), POINTER :: field(:)
    TYPE(t_cellset), TARGET :: cells(:)
    INTEGER,INTENT(IN) :: ncell_tot, nlev, nq
@@ -275 +389 @@
       sgn=1
    END IF
+
 
    n_beg=0
@@ -324 +439 @@
   END SUBROUTINE xios_set_context
 
+ SUBROUTINE xios_set_context_input
+ IMPLICIT NONE   
+  TYPE(xios_context) :: ctx_hdl
+
+!$OMP MASTER 
+   CALL xios_get_handle("icosagcm_input",ctx_hdl)
+   CALL xios_set_current_context(ctx_hdl)
+!$OMP END MASTER
+
+  END SUBROUTINE xios_set_context_input
 
 #else
@@ -376 +501 @@
   END SUBROUTINE xios_write_field_finalize
   
+  SUBROUTINE xios_init_write_field_input
+  END SUBROUTINE
+
   SUBROUTINE xios_init_write_field
   END SUBROUTINE xios_init_write_field