Changeset 947

Timestamp:

07/10/19 16:31:55 (5 years ago)

Author:

jisesh

Message:

devel: Nudging external data and vertical interpolatiion

Location:

codes/icosagcm/devel/src

Files:

• dissip/nudging_mod.f90 (modified) (2 diffs)
• vertical/vertical_remap.f90 (modified) (2 diffs)

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

@@ -44 +44 @@
     nudging_time=0.
     CALL getin('nudging_time', nudging_time)
-
+    nudging_time = nudging_time/scale_factor
     ! we should check that radius>0
     CALL getin("guided_nudging_field",guided_nudging_field)
@@ -147 +147 @@
     USE transfert_mod
     USE time_mod
+    USE pression_mod
+    USE vertical_remap_mod
     REAL(rstd), INTENT(IN):: tt
     TYPE(t_field),POINTER :: f_ps(:)
+    TYPE(t_field),POINTER,SAVE :: f_pmid_target(:)
     TYPE(t_field),POINTER :: f_phis(:)
     TYPE(t_field),POINTER :: f_theta_rhodz(:)
     TYPE(t_field),POINTER :: f_u(:)  
     TYPE(t_field),POINTER :: f_q(:)
-    TYPE(t_field),POINTER, SAVE :: f_T_guided(:),  f_ulon_guided(:), f_ulat_guided(:),f_pressure_mid(:) 
+    TYPE(t_field),POINTER, SAVE :: f_T_guided(:),  f_ulon_guided(:), f_ulat_guided(:),f_T_guided_interp(:), &
+                                   f_ulon_guided_interp(:),f_ulat_guided_interp(:)
     REAL(rstd), POINTER :: target_ue(:,:), ue(:,:), coef_e(:)
     REAL(rstd), POINTER :: target_theta_rhodz(:,:,:), theta_rhodz(:,:,:), coef_i(:) 
     INTEGER :: ind
-
-    IF (abs(MOD(tt,REAL(nudging_time))-dt) < 1.0D-2) THEN
-
+    
+    IF (abs(MOD(tt,REAL(nudging_time))-dt) < 1.0D-2) THEN 
+       
       CALL allocate_field(f_T_guided, field_t, type_real, llm, name='nudging_T')
+      CALL allocate_field(f_T_guided_interp, field_t, type_real, llm, name='nudging_T')
+      CALL allocate_field(f_ulon_guided_interp, field_t, type_real, llm, name='nudging_T')
+      CALL allocate_field(f_ulat_guided_interp, field_t, type_real, llm, name='nudging_T')
       CALL allocate_field(f_ulon_guided, field_t, type_real, llm, name='nudging_ulon')
       CALL allocate_field(f_ulat_guided, field_t, type_real, llm, name='nudging_ulat')
-
+      CALL allocate_field(f_pmid_target,field_t,type_real,llm,name='target_pressure') 
       CALL xios_read_field("T_guided_read",f_T_guided)
+      CALL pression_mid(f_ps, f_pmid_target)
+      CALL vertical_remap_extdata(f_T_guided,f_pmid_target,f_T_guided_interp)
       CALL transfert_request(f_T_guided,req_i0)
-      CALL temperature2theta_rhodz(f_ps,f_T_guided,f_target_theta_rhodz)
+      CALL transfert_request(f_T_guided_interp,req_i0)
+      CALL transfert_request(f_T_guided,req_i1)
+      CALL transfert_request(f_T_guided_interp,req_i1)
+      CALL temperature2theta_rhodz(f_ps,f_T_guided_interp,f_target_theta_rhodz)
       CALL xios_read_field("ulon_guided_read",f_ulon_guided)
       CALL xios_read_field("ulat_guided_read",f_ulat_guided)
+      CALL vertical_remap_extdata(f_ulon_guided,f_pmid_target,f_ulon_guided_interp)
+      CALL vertical_remap_extdata(f_ulat_guided,f_pmid_target,f_ulat_guided_interp)
       CALL transfert_request(f_ulon_guided,req_i0)
+      CALL transfert_request(f_ulon_guided_interp,req_i0)
       CALL transfert_request(f_ulat_guided,req_i0)
+      CALL transfert_request(f_ulat_guided_interp,req_i0)
       CALL transfert_request(f_ulon_guided,req_i1)
+      CALL transfert_request(f_ulon_guided_interp,req_i1)
       CALL transfert_request(f_ulat_guided,req_i1)
+      CALL transfert_request(f_ulat_guided_interp,req_i1)
       CALL xios_write_field("ulat_guided_out",f_ulat_guided)
       CALL xios_write_field("ulon_guided_out",f_ulon_guided)
-      CALL ulonlat2un(f_ulon_guided, f_ulat_guided,f_target_ue)
-
+      CALL xios_write_field("T_guided_out",f_T_guided)
+      CALL ulonlat2un(f_ulon_guided_interp, f_ulat_guided,f_target_ue) 
       CALL deallocate_field(f_T_guided)
+      CALL deallocate_field(f_T_guided_interp)
       CALL deallocate_field(f_ulon_guided)
+      CALL deallocate_field(f_ulon_guided_interp)
       CALL deallocate_field(f_ulat_guided)
+      CALL deallocate_field(f_ulat_guided_interp)
+      CALL deallocate_field(f_pmid_target)
     
     ENDIF

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

@@ -4 +4 @@
   IMPLICIT NONE
   PRIVATE
+PUBLIC vertical_remap_extdata,compute_vertical_remap_extdata
 
   PUBLIC :: vertical_remap
@@ -107 +108 @@
   END SUBROUTINE compute_vertical_remap
 
+  SUBROUTINE vertical_remap_extdata(field_in,f_target_pressure,field_out)
+  USE icosa
+  USE pression_mod
+  USE omp_para
+  USE disvert_mod, ONLY : presnivs
+
+  IMPLICIT NONE
+    TYPE(t_field),POINTER :: field_in(:) 
+    TYPE(t_field),POINTER :: field_out(:)
+    TYPE(t_field),POINTER :: f_target_pressure(:)
+
+    REAL(rstd),POINTER :: target_pressure(:,:)
+    REAL(rstd),POINTER :: in(:,:)
+    REAL(rstd),POINTER :: out(:,:)
+    INTEGER :: ind
+
+    DO ind=1,ndomain
+      IF (.NOT. assigned_domain(ind)) CYCLE
+      CALL swap_dimensions(ind)
+      CALL swap_geometry(ind)
+      in=field_in(ind)
+      out=field_out(ind)
+      target_pressure=f_target_pressure(ind)
+      CALL compute_vertical_remap_extdata(in,target_pressure,out)
+    ENDDO
+
+  END SUBROUTINE vertical_remap_extdata
+
+  SUBROUTINE compute_vertical_remap_extdata(in,target_pressure,out2d_press)
+  USE omp_para
+  USE disvert_mod, ONLY : presnivs 
+  IMPLICIT NONE
+    REAL(rstd),INTENT(IN)  :: in(:,:)
+    REAL(rstd),INTENT(IN)  :: target_pressure(iim*jjm,llm+1) 
+    REAL(rstd),INTENT(OUT) :: out2d_press(iim*jjm,llm+1)
+    REAL(rstd) :: coeff, target_pval,testp1,testp2
+    INTEGER :: i,j,ij,l,n,nb_level
+    INTEGER :: a
+    INTEGER :: b
+    LOGICAL :: positive
+   
+    nb_level=size(presnivs)
+ !$OMP BARRIER    
+    IF (is_omp_level_master) THEN
+    DO l=1,llm
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          target_pval=target_pressure(ij,l)
+            a=0
+            DO n=1,nb_level-1
+              IF ( (target_pval<=presnivs(n) .AND. target_pval>=presnivs(n+1))) THEN
+               testp1=presnivs(n); testp2=presnivs(n+1)
+               a=n ; b=n+1 ; EXIT
+              ENDIF
+            ENDDO
+            IF (a==0) THEN
+              IF (target_pval>=presnivs(1)) THEN
+                a=1 ; b=2
+              ELSE
+                a=nb_level-1 ; b=nb_level
+              ENDIF
+            ENDIF
+
+          coeff=(target_pval-presnivs(a))/(presnivs(a)-presnivs(b))
+          out2d_press(ij,l)=in(ij,a)+coeff*(in(ij,a)-in(ij,b))
+        ENDDO
+      ENDDO
+    ENDDO
+
+    ENDIF
+ !$OMP BARRIER    
+
+  END SUBROUTINE compute_vertical_remap_extdata
+
+
+
 END MODULE vertical_remap_mod