Changeset 950

Timestamp:

07/14/19 14:40:34 (5 years ago)

Author:

dubos

Message:

devel/unstructured : towards Fortran driver for DYNAMICO-unstructured

Location:

codes/icosagcm/devel/src

Files:

• base/field.f90 (modified) (3 diffs)
• dissip/dissip_gcm.f90 (modified) (1 diff)
• time/euler_scheme.f90 (modified) (4 diffs)
• time/hevi_scheme.f90 (modified) (5 diffs)
• time/timeloop_gcm.f90 (modified) (2 diffs)

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

@@ -365 +365 @@
     field_pt=>field%rval2d
     IF(grid_type == grid_unst) THEN
-       PRINT *, 'getval_r2d for ' // TRIM(field%name) // ' : ', SHAPE(field_pt)
+!       PRINT *, 'getval_r2d for ' // TRIM(field%name) // ' : ', SHAPE(field_pt)
     END IF
   END SUBROUTINE  getval_r2d
@@ -381 +381 @@
     field_pt=>field%rval3d
     IF(grid_type == grid_unst) THEN
-       PRINT *, 'getval_r3d for ' // TRIM(field%name) // ' : ', SHAPE(field_pt)
+!       PRINT *, 'getval_r3d for ' // TRIM(field%name) // ' : ', SHAPE(field_pt)
     END IF
   END SUBROUTINE  getval_r3d
@@ -396 +396 @@
     field_pt=>field%rval4d
     IF(grid_type == grid_unst) THEN
-       PRINT *, 'getval_r4d for ' // TRIM(field%name) // ' : ', SHAPE(field_pt)
+!       PRINT *, 'getval_r4d for ' // TRIM(field%name) // ' : ', SHAPE(field_pt)
     END IF
   END SUBROUTINE  getval_r4d  

codes/icosagcm/devel/src/dissip/dissip_gcm.f90

@@ -127 +127 @@
        CALL dissip_profile
        CALL dissip_timescale
+    ELSE ! FIXME unstructured
+       itau_dissip=1000000000
     END IF
 

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

@@ -15 +15 @@
        f_dW_slow(:,:), f_dW_fast(:,:)                                 ! vertical momentum tendencies (NH)
 
-  INTEGER, PARAMETER, PUBLIC :: explicit=1, hevi=2, euler=1, rk4=2, mlf=3, rk25=4, ark23=6, ark33=7
+  INTEGER, PARAMETER, PUBLIC :: explicit=1, hevi=2, euler=1, rk4=2, mlf=3, rk25=4, ark23=6, ark33=7, ark11=8
 
   INTEGER,SAVE, PUBLIC :: nb_stage, matsuno_period, scheme, scheme_family
@@ -160 +160 @@
        IF(caldyn_eta==eta_mass .AND. is_omp_first_level) THEN ! update ps
           ps=f_ps(ind)
-          ps(:)=(ps(:)-ptop)/g
+          ps(:)=(ps(:)-ptop)/g ! FIXME : OpenMP+unstructured
        END IF
 
@@ -175 +175 @@
           ENDDO
        CASE(grid_unst)
-          PRINT *, 'legacy_to_DEC', llm, edge_num, SHAPE(u), SHAPE(de) ! FIXME
+!          PRINT *, 'legacy_to_DEC', llm, edge_num, SHAPE(u), SHAPE(de) ! FIXME
           DO ij=1, edge_num
              DO l=1,llm
@@ -206 +206 @@
        IF(caldyn_eta==eta_mass .AND. is_omp_first_level) THEN
           ps=f_ps(ind)
-          !DIR$ SIMD
-          DO ij=ij_begin,ij_end
-             ps(ij)=ptop+ps(ij)*g ! convert column-integrated mass to ps
-          ENDDO
+          ps(:) = ptop + ps(:)*g ! FIXME : OpenMP+unstructured
        ENDIF
        
        u=f_u(ind)
-       DO l=ll_begin,ll_end
-          !DIR$ SIMD
-          DO ij=ij_begin,ij_end
-             u(ij+u_right,l)=u(ij+u_right,l)/de(ij+u_right)
-             u(ij+u_lup,l)=u(ij+u_lup,l)/de(ij+u_lup)
-             u(ij+u_ldown,l)=u(ij+u_ldown,l)/de(ij+u_ldown)
-          ENDDO
-       ENDDO
+       SELECT CASE(grid_type)
+       CASE(grid_ico)
+          DO l=ll_begin,ll_end
+             !DIR$ SIMD
+             DO ij=ij_begin,ij_end
+                u(ij+u_right,l)=u(ij+u_right,l)/de(ij+u_right)
+                u(ij+u_lup,l)=u(ij+u_lup,l)/de(ij+u_lup)
+                u(ij+u_ldown,l)=u(ij+u_ldown,l)/de(ij+u_ldown)
+             ENDDO
+          ENDDO
+       CASE(grid_unst)
+!          PRINT *, 'DEC_to_legacy', llm, edge_num, SHAPE(u), SHAPE(de) ! FIXME
+          DO ij=1, edge_num
+             DO l=1,llm
+                u(l,ij) = u(l,ij)/de(ij)
+             END DO
+          END DO
+       CASE DEFAULT
+          STOP 'Unsupported grid_type encountered in legacy_to_DEC'
+       END SELECT
     ENDDO
 

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

@@ -11 +11 @@
   REAL(rstd), PARAMETER, DIMENSION(3) :: zero = (/0.,0.,0./)
 
-  PUBLIC :: set_coefs_ark23, set_coefs_ark33, hevi_scheme
+  PUBLIC :: set_coefs_ark23, set_coefs_ark33, set_coefs_ark11, hevi_scheme
 
 CONTAINS
@@ -34 +34 @@
   END SUBROUTINE set_coefs_ark33
     
+  SUBROUTINE set_coefs_ark11(dt)
+    ! Euler scheme disguised as ARK for development purposes
+    REAL(rstd) :: dt
+    CALL set_coefs_rk(dt, (/ zero, (/1.,0.,0./), (/0.,0.,0./), (/0./0.,0./0.,0./) /) )
+  END SUBROUTINE set_coefs_ark11
+    
   SUBROUTINE set_coefs_rk(dt, ajl)
     REAL(rstd) :: dt, ajl(3,4)
@@ -42 +48 @@
     REAL(rstd) :: dt, ajl_slow(3,4), ajl_fast(3,4) ! fast/slow Butcher tableaus
     INTEGER :: j
-    DO j=1,3
+    DO j=1,nb_stage
        bjl(:,j) = dt*(ajl_slow(:,j+1)-ajl_slow(:,j))
        cjl(:,j) = dt*(ajl_fast(:,j+1)-ajl_fast(:,j))
        taujj(j) = dt*ajl_fast(j,j)
     END DO
-    wj=dt*ajl_slow(:,4)
+    wj=dt*ajl_slow(:,nb_stage+1)
   END SUBROUTINE set_coefs_hevi
 
@@ -142 +148 @@
     INTENT(INOUT) :: y
     INTENT(IN) :: dy
-    INTEGER :: l
-    DO l=ll_begin,ll_end
+    INTEGER :: l, l_begin, l_end
+    IF(grid_type==grid_ico) THEN
+       l_begin = ll_begin
+       l_end   = l_end
+    ELSE ! unstructured : FIXME OpenMP
+       l_begin = 1
+       l_end   = SIZE(y,2)
+    END IF
+    DO l=l_begin,l_end
        y(:,l)=y(:,l)+w*dy(:,l)
     ENDDO
@@ -157 +170 @@
        IF (.NOT. assigned_domain(ind)) CYCLE
        dy=f_dy(ind); y=f_y(ind)
-       IF (is_omp_level_master) CALL compute_update_2D(w,y,dy)
+       IF (is_omp_level_master) CALL compute_update_2D(w,y,dy) ! FIXME OpenMP+unstructured
     ENDDO
   END SUBROUTINE update_2D

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

@@ -78 +78 @@
        CALL getin('matsuno_period',matsuno_period)
        nb_stage=matsuno_period+1
+    CASE('ARK1.1')
+       scheme_family=hevi
+       scheme=ark11
+       nb_stage=1
+       CALL set_coefs_ark11(dt)
     CASE('ARK2.3')
        scheme_family=hevi
@@ -91 +96 @@
        nb_stage=0
     CASE default
-       PRINT*,'Bad selector for variable scheme : <', TRIM(def),             &
-            ' > options are <euler>, <runge_kutta>, <leapfrog_matsuno>,<RK2.5>,<ARK2.3>'
+       PRINT*,'Bad selector for variable scheme : <' // TRIM(def) // '>, ', &
+            'options are <euler>, <runge_kutta>, <leapfrog_matsuno>, <RK2.5>,<ARK2.3>, ,<ARK1.1>'
        STOP
     END SELECT