Changeset 906 for codes/icosagcm/devel

Timestamp:

06/14/19 01:17:50 (5 years ago)

Author:

dubos

Message:

devel : compute_rhodz for unstructured mesh

Location:

codes/icosagcm/devel/src

Files:

• base/init_grid_param.f90 (modified) (4 diffs)
• diagnostics/compute_diagnostics.f90 (added)
• diagnostics/compute_rhodz.F90 (added)
• diagnostics/observable.f90 (modified) (8 diffs)
• dynamics/caldyn_gcm.F90 (modified) (2 diffs)
• initial/etat0.f90 (modified) (1 diff)
• kernels_hex/compute_rhodz.k90 (added)
• kernels_unst/compute_rhodz.k90 (added)
• time/timeloop_gcm.f90 (modified) (2 diffs)
• vertical/disvert.f90 (modified) (1 diff)

codes/icosagcm/devel/src/base/init_grid_param.f90

@@ -1 +1 @@
 MODULE init_grid_param_mod
+
+  USE compute_diagnostics_mod
+  USE compute_rhodz_mod
+
+  USE compute_caldyn_mod
+  USE compute_pvort_only_mod
+
   IMPLICIT NONE
+  PRIVATE
+  SAVE
+  
+  PUBLIC :: init_grid_param
 
 CONTAINS
@@ -20 +31 @@
        jjm_glo=iim_glo
        IF(is_mpi_root) PRINT *, 'GETIN nbp = ',iim_glo
+       CALL select_compute_hex
     CASE('unstructured')
        grid_type = grid_unst
@@ -26 +38 @@
        CALL open_local_mesh_file
        IF (is_mpi_root) PRINT *,'DYNAMICO mesh is unstructured/LAM.'
+       CALL select_compute_unst
     CASE DEFAULT
        PRINT *, 'Invalid value of grid_type :',TRIM(grid_type_var)
@@ -41 +54 @@
     
   END SUBROUTINE  init_grid_param
+
+
+  SUBROUTINE select_compute_hex
+    compute_rhodz      => compute_rhodz_hex
+    compute_pvort_only => compute_pvort_only_hex
+  END SUBROUTINE select_compute_hex
+
+  SUBROUTINE select_compute_unst
+    compute_rhodz      => compute_rhodz_unst
+    compute_pvort_only => compute_pvort_only_unst
+  END SUBROUTINE select_compute_unst
+
   
 END MODULE init_grid_param_mod
-    

codes/icosagcm/devel/src/diagnostics/observable.f90

@@ -58 +58 @@
 !    IF (is_master) PRINT *,'CALL write_output_fields_basic'
 
-    IF(grid_type==grid_unst) RETURN ! FIXME
-
     CALL transfert_request(f_ps,req_i1)
     
@@ -102 +100 @@
 
     IF(init) THEN
+       CALL output_field("p_init",f_pmid)
+       CALL output_field("ps_init",f_ps)
+       CALL output_field("mass_init",f_mass)
+       CALL output_field("geopot_init",f_geopot)
+       CALL output_field("q_init",f_q)
+
        CALL output_field("temp_init",f_buf_i)
     ELSE
+       CALL output_field("p",f_pmid)
+       CALL output_field("ps",f_ps)
+       CALL output_field("mass",f_mass)
+       CALL output_field("geopot",f_geopot)
+       CALL output_field("q",f_q)
+
        CALL output_field("temp",f_buf_i)
        CALL vertical_interp(f_pmid,f_buf_i,f_buf_s,85000.)
@@ -113 +123 @@
     END IF
     
+    IF(grid_type == grid_unst) RETURN
+
     CALL progonostic_vel_to_horiz(f_geopot, f_ps, f_mass, f_u, f_W, f_buf_uh, f_buf_i)
     CALL transfert_request(f_buf_uh,req_e1_vect) 
@@ -120 +132 @@
        CALL output_field("ulon_init",f_buf_ulon)
        CALL output_field("ulat_init",f_buf_ulat)
-       CALL output_field("p_init",f_pmid)
-       CALL output_field("ps_init",f_ps)
-       CALL output_field("mass_init",f_mass)
-       CALL output_field("geopot_init",f_geopot)
-       CALL output_field("q_init",f_q)
        IF(is_master) PRINT *, 'Done writing initial condition ...'
     ELSE
@@ -130 +137 @@
        CALL output_field("ulon",f_buf_ulon)
        CALL output_field("ulat",f_buf_ulat)
-       CALL output_field("p",f_pmid)
-       CALL output_field("ps",f_ps)
-       CALL output_field("mass",f_mass)
-       CALL output_field("geopot",f_geopot)
-       CALL output_field("q",f_q)
 
        !       CALL output_field("exner",f_pk)
@@ -211 +213 @@
 
   SUBROUTINE progonostic_vel_to_horiz(f_geopot, f_ps, f_rhodz, f_u, f_W, f_uh, f_uz)
-    USE disvert_mod
+    USE disvert_mod, ONLY : caldyn_eta, eta_mass
+    USE compute_diagnostics_mod, ONLY : compute_rhodz
     TYPE(t_field), POINTER :: f_geopot(:), f_ps(:), f_rhodz(:), &
          f_u(:), f_W(:), f_uz(:), &  ! IN
@@ -294 +297 @@
     USE pression_mod
     IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_pmid(:)           ! IN
+    TYPE(t_field), POINTER :: f_pmid(:)         ! IN
     TYPE(t_field), POINTER :: f_q(:)            ! IN
     TYPE(t_field), POINTER :: f_temp(:)         ! INOUT
@@ -329 +332 @@
           p_ik = pmid(ij,l)
           theta_ik = temp(ij,l)
-          qv = q(ij,l,1) ! water vaper mixing ratio = mv/md
+          qv = q(ij,l,1) ! water vapor mixing ratio = mv/md
           SELECT CASE(caldyn_thermo)
           CASE(thermo_theta)

codes/icosagcm/devel/src/dynamics/caldyn_gcm.F90

@@ -16 +16 @@
   
   SUBROUTINE init_caldyn
-    USE compute_caldyn_mod, ONLY : compute_pvort_only
-    USE compute_pvort_only_mod, ONLY : compute_pvort_only_hex, compute_pvort_only_unst
 
     CHARACTER(len=255) :: def
@@ -160 +158 @@
           CALL compute_planetvel(planetvel)
        END DO
-       compute_pvort_only => compute_pvort_only_hex
     CASE(grid_unst)
-       compute_pvort_only => compute_pvort_only_unst
     END SELECT
 

codes/icosagcm/devel/src/initial/etat0.f90

@@ -63 +63 @@
     USE omp_para, ONLY : is_omp_level_master
     USE mpipara, ONLY : is_mpi_root
-    USE disvert_mod
+    USE disvert_mod, ONLY : caldyn_eta, eta_lag
+    USE compute_diagnostics_mod, ONLY : compute_rhodz
     ! Generic interface
     USE etat0_isothermal_mod, ONLY : getin_etat0_isothermal=>getin_etat0

codes/icosagcm/devel/src/time/timeloop_gcm.f90

@@ -5 +5 @@
   USE trace
   USE omp_para
+  USE compute_diagnostics_mod, ONLY : compute_rhodz
   USE euler_scheme_mod
   USE explicit_scheme_mod
@@ -247 +248 @@
     !$OMP END MASTER   
 
+    IF(grid_type == grid_unst) RETURN
+
     DO it=itau0+1,itau0+itaumax
        IF (is_master) CALL print_iteration(it, itau0, itaumax, start_clock, rate_clock)

codes/icosagcm/devel/src/vertical/disvert.f90

@@ -148 +148 @@
   END SUBROUTINE init_disvert  
   
-  SUBROUTINE compute_rhodz(comp, ps, rhodz)
-    USE icosa
-    USE omp_para
-    LOGICAL, INTENT(IN) :: comp ! .TRUE. to compute, .FALSE. to check
-    REAL(rstd), INTENT(IN) :: ps(iim*jjm)
-    REAL(rstd), INTENT(INOUT) :: rhodz(iim*jjm,llm)
-    REAL(rstd) :: m, err
-    INTEGER :: l,i,j,ij,dd
-    err=0.
-
-    IF(comp) THEN
-       dd=1
-    ELSE
-       dd=0
-    END IF
-
-    DO l = ll_begin, ll_end
-       DO j=jj_begin-dd,jj_end+dd
-          DO i=ii_begin-dd,ii_end+dd
-             ij=(j-1)*iim+i
-             m = ( ap(l) - ap(l+1) + (bp(l)-bp(l+1))*ps(ij) )/g 
-             IF(comp) THEN
-                rhodz(ij,l) = m
-             ELSE
-                err = MAX(err,abs(m-rhodz(ij,l)))
-             END IF
-          ENDDO
-       ENDDO
-    ENDDO
-
-    IF(.NOT. comp) THEN
-       IF(err>1e-10) THEN
-          PRINT *, 'Discrepancy between ps and rhodz detected', err
-          STOP
-       ELSE
-!          PRINT *, 'No discrepancy between ps and rhodz detected'
-       END IF
-    END IF
-
-  END SUBROUTINE compute_rhodz
-
- 
   SUBROUTINE write_apbp
   USE icosa