Changeset 260 for codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/wind.f90

Timestamp:

07/29/14 10:10:51 (10 years ago)

Author:

ymipsl

Message:

Implement restartability for dynamico

YM

File:

• codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/wind.f90 (modified) (3 diffs)

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

@@ -24 +24 @@
   END SUBROUTINE un2ulonlat
 
+  SUBROUTINE ulonlat2un(f_ulon, f_ulat,f_u)
+  USE icosa
+  IMPLICIT NONE
+    TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! IN : velocity reconstructed at hexagons
+    TYPE(t_field), POINTER :: f_u(:) ! OUT  : normal velocity components on edges
+    
+    REAL(rstd),POINTER :: u(:,:),  ulon(:,:), ulat(:,:)
+    INTEGER :: ind
+
+    DO ind=1,ndomain
+       IF (.NOT. assigned_domain(ind)) CYCLE
+       CALL swap_dimensions(ind)
+       CALL swap_geometry(ind)
+       u=f_u(ind)
+       ulon=f_ulon(ind)
+       ulat=f_ulat(ind)
+       CALL compute_ulonlat2un(ulon, ulat,u)
+    END DO
+
+  END SUBROUTINE ulonlat2un
  
   SUBROUTINE compute_wind_centered(ue,ucenter)
@@ -298 +318 @@
  END SUBROUTINE compute_wind_centered_lonlat_compound
 
+ SUBROUTINE compute_wind_centered_from_wind_lonlat_centered(ulon, ulat,uc)
+  USE icosa  
+    
+  IMPLICIT NONE
+  REAL(rstd) :: ulon(iim*jjm,llm)
+  REAL(rstd) :: ulat(iim*jjm,llm)
+  REAL(rstd) :: uc(iim*jjm,3,llm)
+
+  INTEGER :: i,j,ij,l     
+    
+  
+    DO l=1,llm
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          uc(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ulat(ij,l)*elat_i(ij,:)
+        ENDDO
+      ENDDO
+    ENDDO
+ 
+ END SUBROUTINE compute_wind_centered_from_wind_lonlat_centered
+
+
+
+ SUBROUTINE compute_wind_perp_from_wind_centered(uc,un)
+  USE icosa  
+    
+  IMPLICIT NONE
+  REAL(rstd),INTENT(IN)   :: uc(iim*jjm,3,llm)
+  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm)
+
+  INTEGER :: i,j,ij,l     
+    
+  
+    DO l=1,llm
+      DO j=jj_begin,jj_end
+        DO i=ii_begin,ii_end
+          ij=(j-1)*iim+i
+          un(ij+u_right,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:))
+          un(ij+u_lup,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:))
+          un(ij+u_ldown,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:))
+         ENDDO
+      ENDDO
+    ENDDO
+ 
+ END SUBROUTINE compute_wind_perp_from_wind_centered
+
+
  SUBROUTINE compute_un2ulonlat(un, ulon, ulat)
   USE icosa  
@@ -313 +381 @@
  END SUBROUTINE compute_un2ulonlat
 
+ SUBROUTINE compute_ulonlat2un(ulon, ulat,un)
+  USE icosa  
+    
+  IMPLICIT NONE
+  REAL(rstd),INTENT(IN) :: ulon(iim*jjm,llm)
+  REAL(rstd),INTENT(IN) :: ulat(iim*jjm,llm)
+  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm)
+
+  REAL(rstd)             :: uc(iim*jjm,3,llm)
+    
+    CALL compute_wind_centered_from_wind_lonlat_centered(ulon, ulat, uc)  
+    CALL compute_wind_perp_from_wind_centered(uc, un)
+ 
+ END SUBROUTINE compute_ulonlat2un
+
+
 END MODULE wind_mod