Ignore:
Timestamp:
10/19/17 17:04:26 (7 years ago)
Author:
dubos
Message:

trunk : backported commits r582-r598 (transport diagnostics)

File:
1 moved

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/diagnostics/wind.F90

    r581 r599  
    11MODULE wind_mod 
    2  
    3 CONTAINS 
    4  
    5   SUBROUTINE un2ulonlat(f_u, f_ulon, f_ulat) 
     2  USE omp_para 
    63  USE icosa 
    74  IMPLICIT NONE 
     5  PRIVATE 
     6 
     7  PUBLIC :: compute_wind_centered, compute_flux_centered, & 
     8       compute_wind_centered_lonlat_compound, compute_wind2d_perp_from_lonlat_compound, & 
     9       compute_wind_centered_from_lonlat_compound, compute_wind_perp_from_lonlat_compound, & 
     10       un2ulonlat, ulonlat2un 
     11        
     12CONTAINS 
     13 
     14  SUBROUTINE un2ulonlat(f_u, f_ulon, f_ulat) 
    815    TYPE(t_field), POINTER :: f_u(:) ! IN  : normal velocity components on edges 
    9     TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! OUT : velocity reconstructed at hexagons 
    10      
     16    TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! OUT : velocity reconstructed at hexagons     
    1117    REAL(rstd),POINTER :: u(:,:),  ulon(:,:), ulat(:,:) 
    1218    INTEGER :: ind 
    … …  
    2531 
    2632  SUBROUTINE ulonlat2un(f_ulon, f_ulat,f_u) 
    27   USE icosa 
    28   IMPLICIT NONE 
    2933    TYPE(t_field), POINTER :: f_ulon(:), f_ulat(:) ! IN : velocity reconstructed at hexagons 
    3034    TYPE(t_field), POINTER :: f_u(:) ! OUT  : normal velocity components on edges 
    … …  
    4650  
    4751  SUBROUTINE compute_wind_centered(ue,ucenter) 
    48   USE icosa 
    49   USE omp_para 
    50   IMPLICIT NONE 
    5152  REAL(rstd) :: ue(3*iim*jjm,llm) 
    52   REAL(rstd) :: ucenter(iim*jjm,3,llm) 
    53   INTEGER :: i,j,ij,l     
    54   
     53  REAL(rstd) :: ucenter(iim*jjm,llm,3) 
     54  INTEGER :: ij,l 
     55  REAL(rstd), PARAMETER :: scale=1. 
     56  REAL(rstd) :: fac, ue_le, cx,cy,cz, ux,uy,uz 
     57#include "../kernels/wind_centered.k90" 
     58 END SUBROUTINE compute_wind_centered 
     59  
     60  SUBROUTINE compute_flux_centered(scale,ue,ucenter) 
     61  REAL(rstd), INTENT(IN) :: scale 
     62  REAL(rstd) :: ue(3*iim*jjm,llm) 
     63  REAL(rstd) :: ucenter(iim*jjm,llm,3) 
     64  INTEGER :: ij,l 
     65  REAL(rstd) :: fac, ue_le, cx,cy,cz, ux,uy,uz 
     66#include "../kernels/flux_centered.k90" 
     67  END SUBROUTINE compute_flux_centered 
     68  
     69   
     70 SUBROUTINE compute_wind_on_edge(ue,uedge) 
     71  REAL(rstd) :: ue(3*iim*jjm,llm) 
     72  REAL(rstd) :: uedge(3*iim*jjm,llm,3) 
     73 
     74  REAL(rstd) :: ut(3*iim*jjm,llm) 
     75  INTEGER :: i,j,ij,l      
     76     
     77    CALL compute_tangential_compound(ue,ut) 
     78   
    5579    DO l=ll_begin,ll_end 
    5680      DO j=jj_begin,jj_end 
    5781        DO i=ii_begin,ii_end 
    5882          ij=(j-1)*iim+i 
    59           ucenter(ij,:,l)=1/Ai(ij)*                                                                                                & 
    60                         ( ne(ij,right)*ue(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_v(ij+z_rup,:))/2-centroid(ij,:))  & 
    61                          + ne(ij,rup)*ue(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_v(ij+z_up,:))/2-centroid(ij,:))          & 
    62                          + ne(ij,lup)*ue(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_v(ij+z_lup,:))/2-centroid(ij,:))          & 
    63                          + ne(ij,left)*ue(ij+u_left,l)*le(ij+u_left)*((xyz_v(ij+z_lup,:)+xyz_v(ij+z_ldown,:))/2-centroid(ij,:))    & 
    64                          + ne(ij,ldown)*ue(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_v(ij+z_ldown,:)+xyz_v(ij+z_down,:))/2-centroid(ij,:))& 
    65                          + ne(ij,rdown)*ue(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_v(ij+z_down,:)+xyz_v(ij+z_rdown,:))/2-centroid(ij,:))) 
    66         ENDDO 
    67       ENDDO 
    68     ENDDO 
    69   
    70  END SUBROUTINE compute_wind_centered 
    71   
    72    
    73  SUBROUTINE compute_wind_on_edge(ue,uedge) 
    74   USE icosa 
    75   USE omp_para 
    76      
    77   IMPLICIT NONE 
    78   REAL(rstd) :: ue(3*iim*jjm,llm) 
    79   REAL(rstd) :: uedge(3*iim*jjm,3,llm) 
    80  
    81   REAL(rstd) :: ut(3*iim*jjm,llm) 
    82   INTEGER :: i,j,ij,l      
    83      
    84     CALL compute_tangential_compound(ue,ut) 
    85    
    86     DO l=ll_begin,ll_end 
    87       DO j=jj_begin,jj_end 
    88         DO i=ii_begin,ii_end 
    89           ij=(j-1)*iim+i 
    90           uedge(ij+u_right,:,l)=ue(ij+u_right,l)*ep_e(ij+u_right,:)*ne(ij,right) + ut(ij+u_right,l)*et_e(ij+u_right,:)*ne(ij,right)  
    91           uedge(ij+u_lup,:,l)=ue(ij+u_lup,l)*ep_e(ij+u_lup,:)*ne(ij,lup) + ut(ij+u_lup,l)*et_e(ij+u_lup,:)*ne(ij,lup) 
    92           uedge(ij+u_ldown,:,l)=ue(ij+u_ldown,l)*ep_e(ij+u_ldown,:)*ne(ij,ldown) + ut(ij+u_ldown,l)*et_e(ij+u_ldown,:)*ne(ij,ldown) 
     83          uedge(ij+u_right,l,:)=ue(ij+u_right,l)*ep_e(ij+u_right,:)*ne(ij,right) + ut(ij+u_right,l)*et_e(ij+u_right,:)*ne(ij,right)  
     84          uedge(ij+u_lup,l,:)=ue(ij+u_lup,l)*ep_e(ij+u_lup,:)*ne(ij,lup) + ut(ij+u_lup,l)*et_e(ij+u_lup,:)*ne(ij,lup) 
     85          uedge(ij+u_ldown,l,:)=ue(ij+u_ldown,l)*ep_e(ij+u_ldown,:)*ne(ij,ldown) + ut(ij+u_ldown,l)*et_e(ij+u_ldown,:)*ne(ij,ldown) 
    9386        ENDDO 
    9487      ENDDO 
    … …  
    10093  
    10194 SUBROUTINE compute_tangential_compound(ue,ut) 
    102   USE icosa   
    103   USE omp_para 
    104   IMPLICIT NONE 
    10595  REAL(rstd) :: ue(3*iim*jjm,llm) 
    10696  REAL(rstd) :: ut(3*iim*jjm,llm) 
    … …  
    155145 END SUBROUTINE compute_tangential_compound 
    156146  
    157  SUBROUTINE compute_wind_lonlat_compound(u, ulon, ulat) 
    158   USE icosa   
    159   USE omp_para 
    160      
    161   IMPLICIT NONE 
    162   REAL(rstd) :: u(3*iim*jjm,3,llm) 
    163   REAL(rstd) :: ulon(3*iim*jjm,3,llm) 
    164   REAL(rstd) :: ulat(3*iim*jjm,3,llm) 
    165  
    166   INTEGER :: i,j,ij,l      
    167      
     147! SUBROUTINE compute_wind_lonlat_compound(u, ulon, ulat) 
     148!  REAL(rstd) :: u(3*iim*jjm,3,llm) 
     149!  REAL(rstd) :: ulon(3*iim*jjm,3,llm) 
     150!  REAL(rstd) :: ulat(3*iim*jjm,3,llm) 
     151! 
     152!  INTEGER :: i,j,ij,l      
     153!     
     154!   
     155!    DO l=ll_begin,ll_end 
     156!      DO j=jj_begin-1,jj_end+1 
     157!        DO i=ii_begin-1,ii_end+1 
     158!          ij=(j-1)*iim+i 
     159!          ulon(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elon_e(ij+u_right,:))*elon_e(ij+u_right,:)  
     160!          ulon(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elon_e(ij+u_lup,:))*elon_e(ij+u_lup,:) 
     161!          ulon(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elon_e(ij+u_ldown,:))*elon_e(ij+u_ldown,:) 
     162!           
     163!          ulat(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elat_e(ij+u_right,:))*elat_e(ij+u_right,:)  
     164!          ulat(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elat_e(ij+u_lup,:))*elat_e(ij+u_lup,:)  
     165!          ulat(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elat_e(ij+u_ldown,:))*elat_e(ij+u_ldown,:)  
     166!           
     167!        ENDDO 
     168!      ENDDO 
     169!    ENDDO 
     170!  
     171! END SUBROUTINE compute_wind_lonlat_compound 
     172  
     173  SUBROUTINE compute_wind_from_lonlat_compound(ulon, ulat, u) 
     174  REAL(rstd) :: u(3*iim*jjm,llm,3) 
     175  REAL(rstd) :: ulon(3*iim*jjm,llm) 
     176  REAL(rstd) :: ulat(3*iim*jjm,llm) 
     177 
     178  INTEGER :: i,j,ij,l      
    168179   
    169180    DO l=ll_begin,ll_end 
    … …  
    171182        DO i=ii_begin-1,ii_end+1 
    172183          ij=(j-1)*iim+i 
    173           ulon(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elon_e(ij+u_right,:))*elon_e(ij+u_right,:)  
    174           ulon(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elon_e(ij+u_lup,:))*elon_e(ij+u_lup,:) 
    175           ulon(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elon_e(ij+u_ldown,:))*elon_e(ij+u_ldown,:) 
    176            
    177           ulat(ij+u_right,:,l)=sum(u(ij+u_right,:,l)*elat_e(ij+u_right,:))*elat_e(ij+u_right,:)  
    178           ulat(ij+u_lup,:,l)=sum(u(ij+u_lup,:,l)*elat_e(ij+u_lup,:))*elat_e(ij+u_lup,:)  
    179           ulat(ij+u_ldown,:,l)=sum(u(ij+u_ldown,:,l)*elat_e(ij+u_ldown,:))*elat_e(ij+u_ldown,:)  
    180            
    181         ENDDO 
    182       ENDDO 
    183     ENDDO 
    184   
    185  END SUBROUTINE compute_wind_lonlat_compound 
    186   
    187   SUBROUTINE compute_wind_from_lonlat_compound(ulon, ulat, u) 
    188   USE icosa   
    189   USE omp_para 
    190      
    191   IMPLICIT NONE 
    192   REAL(rstd) :: u(3*iim*jjm,3,llm) 
    193   REAL(rstd) :: ulon(3*iim*jjm,llm) 
    194   REAL(rstd) :: ulat(3*iim*jjm,llm) 
    195  
    196   INTEGER :: i,j,ij,l      
    197    
    198     DO l=ll_begin,ll_end 
    199       DO j=jj_begin-1,jj_end+1 
    200         DO i=ii_begin-1,ii_end+1 
    201           ij=(j-1)*iim+i 
    202           u(ij+u_right,:,l)=ulon(ij+u_right,l)*elon_e(ij+u_right,:)+ ulat(ij+u_right,l)*elat_e(ij+u_right,:) 
    203           u(ij+u_lup,:,l)=ulon(ij+u_lup,l)*elon_e(ij+u_lup,:) + ulat(ij+u_lup,l)*elat_e(ij+u_lup,:) 
    204           u(ij+u_ldown,:,l)=ulon(ij+u_ldown,l)*elon_e(ij+u_ldown,:) + ulat(ij+u_ldown,l)*elat_e(ij+u_ldown,:) 
     184          u(ij+u_right,l,:)=ulon(ij+u_right,l)*elon_e(ij+u_right,:)+ ulat(ij+u_right,l)*elat_e(ij+u_right,:) 
     185          u(ij+u_lup,l,:)=ulon(ij+u_lup,l)*elon_e(ij+u_lup,:) + ulat(ij+u_lup,l)*elat_e(ij+u_lup,:) 
     186          u(ij+u_ldown,l,:)=ulon(ij+u_ldown,l)*elon_e(ij+u_ldown,:) + ulat(ij+u_ldown,l)*elat_e(ij+u_ldown,:) 
    205187        ENDDO 
    206188      ENDDO 
    … …  
    210192  
    211193  SUBROUTINE compute_wind_centered_from_lonlat_compound(ulon, ulat, u) 
    212   USE icosa   
    213   USE omp_para 
    214      
    215   IMPLICIT NONE 
    216   REAL(rstd) :: u(iim*jjm,3,llm) 
     194  REAL(rstd) :: u(iim*jjm,llm,3) 
    217195  REAL(rstd) :: ulon(iim*jjm,llm) 
    218196  REAL(rstd) :: ulat(iim*jjm,llm) 
    219  
    220197  INTEGER :: i,j,ij,l      
    221198  DO l=ll_begin,ll_end 
    … …  
    223200        DO i=ii_begin-1,ii_end+1 
    224201          ij=(j-1)*iim+i 
    225           u(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ ulat(ij,l)*elat_i(ij,:) 
    226         ENDDO 
    227       ENDDO 
    228     ENDDO 
    229   
     202          u(ij,l,:)=ulon(ij,l)*elon_i(ij,:)+ ulat(ij,l)*elat_i(ij,:) 
     203        ENDDO 
     204      ENDDO 
     205    ENDDO  
    230206  END SUBROUTINE compute_wind_centered_from_lonlat_compound 
    231207  
    232208  SUBROUTINE compute_wind2D_from_lonlat_compound(ulon, ulat, u) 
    233   USE icosa   
    234    
    235   IMPLICIT NONE 
    236209  REAL(rstd) :: u(3*iim*jjm,3) 
    237210  REAL(rstd) :: ulon(3*iim*jjm) 
    … …  
    252225  
    253226  SUBROUTINE compute_wind_perp_from_lonlat_compound(ulon, ulat, up) 
    254   USE icosa   
    255   USE omp_para 
    256      
    257   IMPLICIT NONE 
    258227  REAL(rstd) :: up(3*iim*jjm,llm) 
    259228  REAL(rstd) :: ulon(3*iim*jjm,llm) 
    260229  REAL(rstd) :: ulat(3*iim*jjm,llm) 
    261   REAL(rstd) :: u(3*iim*jjm,3,llm) 
     230  REAL(rstd) :: u(3*iim*jjm,llm,3) 
    262231 
    263232  INTEGER :: i,j,ij,l      
    … …  
    269238        DO i=ii_begin-1,ii_end+1 
    270239          ij=(j-1)*iim+i 
    271           up(ij+u_right,l)=sum(u(ij+u_right,:,l)*ep_e(ij+u_right,:)) 
    272           up(ij+u_lup,l)=sum(u(ij+u_lup,:,l)*ep_e(ij+u_lup,:)) 
    273           up(ij+u_ldown,l)=sum(u(ij+u_ldown,:,l)*ep_e(ij+u_ldown,:)) 
     240          up(ij+u_right,l)=sum(u(ij+u_right,l,:)*ep_e(ij+u_right,:)) 
     241          up(ij+u_lup,l)=sum(u(ij+u_lup,l,:)*ep_e(ij+u_lup,:)) 
     242          up(ij+u_ldown,l)=sum(u(ij+u_ldown,l,:)*ep_e(ij+u_ldown,:)) 
    274243        ENDDO 
    275244      ENDDO 
    … …  
    279248    
    280249  SUBROUTINE compute_wind2D_perp_from_lonlat_compound(ulon, ulat, up) 
    281   USE icosa   
    282      
    283   IMPLICIT NONE 
    284250  REAL(rstd) :: up(3*iim*jjm) 
    285251  REAL(rstd) :: ulon(3*iim*jjm) 
    … …  
    302268    
    303269 SUBROUTINE compute_wind_centered_lonlat_compound(uc, ulon, ulat) 
    304   USE icosa   
    305   USE omp_para 
    306      
    307   IMPLICIT NONE 
    308   REAL(rstd) :: uc(iim*jjm,3,llm) 
     270  REAL(rstd) :: uc(iim*jjm,llm,3) 
    309271  REAL(rstd) :: ulon(iim*jjm,llm) 
    310272  REAL(rstd) :: ulat(iim*jjm,llm) 
    311273 
    312274  INTEGER :: i,j,ij,l      
    313      
    314275   
    315276    DO l=ll_begin,ll_end 
    … …  
    317278        DO i=ii_begin,ii_end 
    318279          ij=(j-1)*iim+i 
    319           ulon(ij,l)=sum(uc(ij,:,l)*elon_i(ij,:)) 
    320           ulat(ij,l)=sum(uc(ij,:,l)*elat_i(ij,:))  
     280          ulon(ij,l)=sum(uc(ij,l,:)*elon_i(ij,:)) 
     281          ulat(ij,l)=sum(uc(ij,l,:)*elat_i(ij,:))  
    321282        ENDDO 
    322283      ENDDO 
    … …  
    326287 
    327288 SUBROUTINE compute_wind_centered_from_wind_lonlat_centered(ulon, ulat,uc) 
    328   USE icosa   
    329   USE omp_para 
    330      
    331   IMPLICIT NONE 
    332289  REAL(rstd) :: ulon(iim*jjm,llm) 
    333290  REAL(rstd) :: ulat(iim*jjm,llm) 
    334   REAL(rstd) :: uc(iim*jjm,3,llm) 
     291  REAL(rstd) :: uc(iim*jjm,llm,3) 
    335292 
    336293  INTEGER :: i,j,ij,l      
    … …  
    341298        DO i=ii_begin,ii_end 
    342299          ij=(j-1)*iim+i 
    343           uc(ij,:,l)=ulon(ij,l)*elon_i(ij,:)+ulat(ij,l)*elat_i(ij,:) 
     300          uc(ij,l,:)=ulon(ij,l)*elon_i(ij,:)+ulat(ij,l)*elat_i(ij,:) 
    344301        ENDDO 
    345302      ENDDO 
    … …  
    348305 END SUBROUTINE compute_wind_centered_from_wind_lonlat_centered 
    349306 
    350  
    351  
    352307 SUBROUTINE compute_wind_perp_from_wind_centered(uc,un) 
    353   USE icosa   
    354   USE omp_para 
    355      
     308 
    356309  IMPLICIT NONE 
    357   REAL(rstd),INTENT(IN)   :: uc(iim*jjm,3,llm) 
     310  REAL(rstd),INTENT(IN)   :: uc(iim*jjm,llm,3) 
    358311  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm) 
    359312 
    … …  
    365318        DO i=ii_begin,ii_end 
    366319          ij=(j-1)*iim+i 
    367           un(ij+u_right,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:)) 
    368           un(ij+u_lup,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:)) 
    369           un(ij+u_ldown,l) = sum(0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:)) 
     320          un(ij+u_right,l) = sum(0.5*(uc(ij,l,:) + uc(ij+t_right,l,:))*ep_e(ij+u_right,:)) 
     321          un(ij+u_lup,l) = sum(0.5*(uc(ij,l,:) + uc(ij+t_lup,l,:))*ep_e(ij+u_lup,:)) 
     322          un(ij+u_ldown,l) = sum(0.5*(uc(ij,l,:) + uc(ij+t_ldown,l,:))*ep_e(ij+u_ldown,:)) 
    370323         ENDDO 
    371324      ENDDO 
    … …  
    376329 
    377330 SUBROUTINE compute_un2ulonlat(un, ulon, ulat) 
    378   USE icosa   
    379      
    380   IMPLICIT NONE 
    381331  REAL(rstd),INTENT(IN)  :: un(3*iim*jjm,llm) 
    382332  REAL(rstd),INTENT(OUT) :: ulon(iim*jjm,llm) 
    383333  REAL(rstd),INTENT(OUT) :: ulat(iim*jjm,llm) 
    384334 
    385   REAL(rstd)             :: uc(iim*jjm,3,llm) 
     335  REAL(rstd)             :: uc(iim*jjm,llm,3) 
    386336     
    387337  CALL compute_wind_centered(un,uc)   
    … …  
    391341 
    392342 SUBROUTINE compute_ulonlat2un(ulon, ulat,un) 
    393   USE icosa   
    394      
    395   IMPLICIT NONE 
    396343  REAL(rstd),INTENT(IN) :: ulon(iim*jjm,llm) 
    397344  REAL(rstd),INTENT(IN) :: ulat(iim*jjm,llm) 
    398345  REAL(rstd),INTENT(OUT)  :: un(3*iim*jjm,llm) 
    399346 
    400   REAL(rstd)             :: uc(iim*jjm,3,llm) 
     347  REAL(rstd)             :: uc(iim*jjm,llm,3) 
    401348     
    402349    CALL compute_wind_centered_from_wind_lonlat_centered(ulon, ulat, uc)   
Note: See TracChangeset for help on using the changeset viewer.