source: codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/physics_lmdz_generic.f90 @ 314

Last change on this file since 314 was 314, checked in by ymipsl, 10 years ago
  • activate splitting of XIOS file in physics so starting time is passed to the physic initialiszation.
  • call restart file periodically using the - itau_write_etat0 - start parameter.

YM
File size: 17.4 KB
Line 
1MODULE physics_lmdz_generic_mod
2  USE field_mod
3  USE transfert_mod
4 
5  INTEGER,SAVE :: nbp_phys
6  TYPE(t_message) :: req_u
7
8  TYPE(t_field),POINTER :: f_p(:) 
9  TYPE(t_field),POINTER :: f_pks(:) 
10  TYPE(t_field),POINTER :: f_pk(:) 
11  TYPE(t_field),POINTER :: f_p_layer(:)   
12  TYPE(t_field),POINTER :: f_theta(:)   
13  TYPE(t_field),POINTER :: f_phi(:)   
14  TYPE(t_field),POINTER :: f_Temp(:)   
15  TYPE(t_field),POINTER :: f_ulon(:)   
16  TYPE(t_field),POINTER :: f_ulat(:)   
17  TYPE(t_field),POINTER :: f_dulon(:)
18  TYPE(t_field),POINTER :: f_dulat(:)
19  TYPE(t_field),POINTER :: f_dTemp(:)
20  TYPE(t_field),POINTER :: f_dq(:)
21  TYPE(t_field),POINTER :: f_dps(:)
22  TYPE(t_field),POINTER :: f_duc(:)
23
24  INTEGER :: start_clock
25  INTEGER :: stop_clock
26  INTEGER :: count_clock=0
27 
28  REAL :: start_day
29  REAL :: day_length
30  REAL :: year_length
31 
32 INTEGER,ALLOCATABLE,SAVE :: domain_offset(:)
33
34 
35
36CONTAINS
37
38  SUBROUTINE init_physics
39  USE icosa
40  USE domain_mod
41  USE dimensions
42  USE mpi_mod
43  USE mpipara
44  USE disvert_mod
45  USE xios_mod
46 
47  IMPLICIT NONE
48  INTEGER  :: distrib(0:mpi_size-1)
49  INTEGER  :: ind,i,j,ij,pos
50
51  REAL(rstd),ALLOCATABLE :: latfi(:)
52  REAL(rstd),ALLOCATABLE :: lonfi(:)
53  REAL(rstd),ALLOCATABLE :: airefi(:)
54  REAL(rstd),ALLOCATABLE :: bounds_latfi(:,:)
55  REAL(rstd),ALLOCATABLE :: bounds_lonfi(:,:)
56  INTEGER :: time0
57
58    start_day=0
59    day_length=86400
60    year_length=86400*365.25
61   
62    CALL getin('start_day',start_day)
63    CALL getin('day_length',day_length)
64    CALL getin('year_length',year_length)
65
66!$OMP PARALLEL
67    CALL allocate_field(f_p,field_t,type_real,llm+1)
68    CALL allocate_field(f_pks,field_t,type_real)
69    CALL allocate_field(f_pk,field_t,type_real,llm)
70    CALL allocate_field(f_p_layer,field_t,type_real,llm)
71    CALL allocate_field(f_theta,field_t,type_real,llm)
72    CALL allocate_field(f_phi,field_t,type_real,llm)
73    CALL allocate_field(f_Temp,field_t,type_real,llm)
74    CALL allocate_field(f_ulon,field_t,type_real,llm)
75    CALL allocate_field(f_ulat,field_t,type_real,llm)
76    CALL allocate_field(f_dulon,field_t,type_real,llm)
77    CALL allocate_field(f_dulat,field_t,type_real,llm)
78    CALL allocate_field(f_dTemp,field_t,type_real,llm)
79    CALL allocate_field(f_dq,field_t,type_real,llm,nqtot)
80    CALL allocate_field(f_dps,field_t,type_real)
81    CALL allocate_field(f_duc,field_t,type_real,3,llm)   
82!$OMP END PARALLEL   
83
84    ALLOCATE(domain_offset(ndomain))
85    nbp_phys=0
86    domain_offset(1)=0
87    DO ind=1,ndomain
88      CALL swap_dimensions(ind)
89      IF (ind<ndomain) THEN
90        domain_offset(ind+1)=domain_offset(ind)+ii_nb*jj_nb
91      ENDIF
92      nbp_phys=nbp_phys+ii_nb*jj_nb
93    ENDDO
94   
95    CALL MPI_ALLGATHER(nbp_phys,1,MPI_INTEGER,distrib,1,MPI_INTEGER,comm_icosa,ierr)
96   
97    ALLOCATE(latfi(nbp_phys))
98    ALLOCATE(lonfi(nbp_phys))
99    ALLOCATE(airefi(nbp_phys))
100    ALLOCATE(bounds_latfi(nbp_phys,6))
101    ALLOCATE(bounds_lonfi(nbp_phys,6))
102   
103    pos=0
104    DO ind=1,ndomain
105      CALL swap_dimensions(ind)
106      CALL swap_geometry(ind)
107      DO j=jj_begin,jj_end
108        DO i=ii_begin,ii_end
109          ij=(j-1)*iim+i
110          pos=pos+1
111          CALL xyz2lonlat(xyz_i(ij,:),lonfi(pos),latfi(pos))
112          CALL xyz2lonlat(xyz_v(ij+z_rup,:), bounds_lonfi(pos,1), bounds_latfi(pos,1))
113          CALL xyz2lonlat(xyz_v(ij+z_up,:), bounds_lonfi(pos,2), bounds_latfi(pos,2))
114          CALL xyz2lonlat(xyz_v(ij+z_lup,:), bounds_lonfi(pos,3), bounds_latfi(pos,3))
115          CALL xyz2lonlat(xyz_v(ij+z_ldown,:), bounds_lonfi(pos,4), bounds_latfi(pos,4))
116          CALL xyz2lonlat(xyz_v(ij+z_down,:), bounds_lonfi(pos,5), bounds_latfi(pos,5))
117          CALL xyz2lonlat(xyz_v(ij+z_rdown,:), bounds_lonfi(pos,6), bounds_latfi(pos,6))
118          airefi(pos)=Ai(ij) 
119        ENDDO
120      ENDDO
121    ENDDO
122
123    time0=itau0*dt
124    CALL initialize_unstructured_physics(nbp_phys,llm, comm_icosa, mpi_size,distrib,            &
125                                         day_length,start_day,time0,itau_physics*dt,                  &
126                                         6,latfi,lonfi,airefi,bounds_lonfi,bounds_latfi,         &
127                                         radius,g, gas_constant/mu, cpp,                        &
128                                         preff, ap, bp)                                         
129   
130    CALL xios_set_context   
131   
132!    CALL init_phys_lmdz(128,97,llm, comm_icosa, mpi_size, distrib)
133   
134    CALL init_gcm_lmdz(nbp_phys,mpi_size,distrib,latfi,lonfi,airefi)
135!    CALL init_phys_lmdz(128,97,llm, comm_icosa, mpi_size, distrib)
136!    CALL iniphysiq(llm,day_length,start_day,itau_physics*dt,     &
137!                   latfi,lonfi,airefi,radius,g, gas_constant/mu, cpp,     &
138!                   ap, bp)
139   
140   
141   
142  END SUBROUTINE init_physics
143 
144  SUBROUTINE physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q)
145  USE ICOSA
146  USE time_mod
147  USE disvert_mod
148  USE transfert_mod
149  USE mpipara
150  USE xios_mod
151  IMPLICIT NONE
152    INTEGER,INTENT(IN)    :: it
153    TYPE(t_field),POINTER :: f_phis(:)
154    TYPE(t_field),POINTER :: f_ps(:)
155    TYPE(t_field),POINTER :: f_theta_rhodz(:)
156    TYPE(t_field),POINTER :: f_u(:)
157    TYPE(t_field),POINTER :: f_wflux(:)
158    TYPE(t_field),POINTER :: f_q(:)
159 
160    REAL(rstd),POINTER :: phis(:)
161    REAL(rstd),POINTER :: ps(:)
162    REAL(rstd),POINTER :: theta_rhodz(:,:)
163    REAL(rstd),POINTER :: u(:,:)
164    REAL(rstd),POINTER :: wflux(:,:)
165    REAL(rstd),POINTER :: q(:,:,:)
166    REAL(rstd),POINTER :: p(:,:)
167    REAL(rstd),POINTER :: pks(:)
168    REAL(rstd),POINTER :: pk(:,:)
169    REAL(rstd),POINTER :: p_layer(:,:)
170    REAL(rstd),POINTER :: theta(:,:)
171    REAL(rstd),POINTER :: phi(:,:)
172    REAL(rstd),POINTER :: Temp(:,:)
173    REAL(rstd),POINTER :: ulon(:,:)
174    REAL(rstd),POINTER :: ulat(:,:)
175    REAL(rstd),POINTER :: dulon(:,:)
176    REAL(rstd),POINTER :: dulat(:,:)
177    REAL(rstd),POINTER :: dTemp(:,:)
178    REAL(rstd),POINTER :: dq(:,:,:)
179    REAL(rstd),POINTER :: dps(:)
180    REAL(rstd),POINTER :: duc(:,:,:)
181
182
183    INTEGER :: ind
184   
185    REAL(rstd),ALLOCATABLE,SAVE :: ps_phy(:)
186    REAL(rstd),ALLOCATABLE,SAVE :: p_phy(:,:)
187    REAL(rstd),ALLOCATABLE,SAVE :: p_layer_phy(:,:)
188    REAL(rstd),ALLOCATABLE,SAVE :: Temp_phy(:,:)
189    REAL(rstd),ALLOCATABLE,SAVE :: phis_phy(:)
190    REAL(rstd),ALLOCATABLE,SAVE :: phi_phy(:,:)
191    REAL(rstd),ALLOCATABLE,SAVE :: ulon_phy(:,:)
192    REAL(rstd),ALLOCATABLE,SAVE :: ulat_phy(:,:)
193    REAL(rstd),ALLOCATABLE,SAVE :: q_phy(:,:,:)
194    REAL(rstd),ALLOCATABLE,SAVE :: wflux_phy(:,:)
195    REAL(rstd),ALLOCATABLE,SAVE :: dulon_phy(:,:)
196    REAL(rstd),ALLOCATABLE,SAVE :: dulat_phy(:,:)
197    REAL(rstd),ALLOCATABLE,SAVE :: dTemp_phy(:,:)
198    REAL(rstd),ALLOCATABLE,SAVE :: dq_phy(:,:,:)
199    REAL(rstd),ALLOCATABLE,SAVE :: dps_phy(:)
200    REAL(rstd) :: dtphy 
201    REAL(rstd) :: time
202    REAL(rstd) :: day
203    REAL(rstd) :: real_time
204    INTEGER    :: offset
205    LOGICAL :: lafin=.FALSE.
206    LOGICAL,SAVE :: first=.TRUE.
207!$OMP THREADPRIVATE(first)
208
209   
210    IF (first) THEN
211      first=.FALSE.
212      CALL init_message(f_u,req_e1_vect,req_u)
213!$OMP MASTER
214      ALLOCATE(ps_phy(nbp_phys))
215      ALLOCATE(p_phy(nbp_phys,llm+1))
216      ALLOCATE(p_layer_phy(nbp_phys,llm))
217      ALLOCATE(Temp_phy(nbp_phys,llm))
218      ALLOCATE(phis_phy(nbp_phys))
219      ALLOCATE(phi_phy(nbp_phys,llm))
220      ALLOCATE(ulon_phy(nbp_phys,llm))
221      ALLOCATE(ulat_phy(nbp_phys,llm))
222      ALLOCATE(q_phy(nbp_phys,llm,nqtot))
223      ALLOCATE(wflux_phy(nbp_phys,llm))
224      ALLOCATE(dulon_phy(nbp_phys,llm))
225      ALLOCATE(dulat_phy(nbp_phys,llm))
226      ALLOCATE(dTemp_phy(nbp_phys,llm))
227      ALLOCATE(dq_phy(nbp_phys,llm,nqtot))
228      ALLOCATE(dps_phy(nbp_phys))
229     
230!$OMP END MASTER
231!$OMP BARRIER
232    ENDIF
233
234    IF(it==itau0+itaumax .OR. it+itau_physics > itau0+itaumax) THEN
235      lafin=.TRUE.
236    ELSE
237      lafin=.FALSE.
238    ENDIF
239
240!$OMP MASTER       
241!    CALL update_calendar(it)
242!$OMP END MASTER
243!$OMP BARRIER
244    dtphy=itau_physics*dt
245    real_time=start_day*day_length+it*dt
246    day  = INT( MODULO(real_time,year_length) / day_length) 
247    time = MODULO(real_time,day_length) / day_length
248
249!$OMP MASTER   
250    IF (is_mpi_root) PRINT*,"Enterring in physic : day", day, "  time : ",time 
251!$OMP END MASTER   
252   
253   
254   
255   
256    CALL transfert_message(f_u,req_u)
257   
258    DO ind=1,ndomain
259      CALL swap_dimensions(ind)
260      IF (assigned_domain(ind)) THEN
261        offset=domain_offset(ind)
262        CALL swap_geometry(ind)
263     
264        phis=f_phis(ind)
265        ps=f_ps(ind)
266        theta_rhodz=f_theta_rhodz(ind)
267        u=f_u(ind)
268        q=f_q(ind)
269        wflux=f_wflux(ind)
270        p=f_p(ind)
271        pks=f_pks(ind)
272        pk=f_pk(ind)
273        p_layer=f_p_layer(ind)
274        theta=f_theta(ind)
275        phi=f_phi(ind)
276        Temp=f_Temp(ind)
277        ulon=f_ulon(ind)
278        ulat=f_ulat(ind)
279           
280        CALL grid_icosa_to_physics
281
282      ENDIF
283    ENDDO
284
285!$OMP BARRIER
286!$OMP MASTER
287    CALL SYSTEM_CLOCK(start_clock)
288!$OMP END MASTER
289    CALL calfis_icosa(dtphy, lafin, day, time, presnivs,      &
290                      p_phy, p_layer_phy, phi_phy, phis_phy, ulon_phy, ulat_phy, Temp_phy, q_phy, wflux_phy, &
291                      dulon_phy, dulat_phy, dTemp_phy, dq_phy, dps_phy  )
292
293
294!$OMP MASTER
295    CALL SYSTEM_CLOCK(stop_clock)
296    count_clock=count_clock+stop_clock-start_clock
297!$OMP END MASTER
298
299!$OMP BARRIER                       
300
301    DO ind=1,ndomain
302      CALL swap_dimensions(ind)
303      IF (assigned_domain(ind)) THEN
304        CALL swap_geometry(ind)
305        offset=domain_offset(ind)
306     
307        theta_rhodz=f_theta_rhodz(ind)
308        u=f_u(ind)
309        q=f_q(ind)
310        ps=f_ps(ind)
311        dulon=f_dulon(ind)
312        dulat=f_dulat(ind)
313        Temp=f_temp(ind)
314        dTemp=f_dTemp(ind)
315        dq=f_dq(ind)
316        dps=f_dps(ind)
317        duc=f_duc(ind)
318        p=f_p(ind)
319        pks=f_pks(ind)
320        pk=f_pk(ind)
321     
322        CALL grid_physics_to_icosa
323      ENDIF
324    ENDDO
325
326!$OMP BARRIER
327    CALL xios_set_context   
328     
329  CONTAINS
330   
331    SUBROUTINE grid_physics_to_icosa
332    USE theta2theta_rhodz_mod
333    USE omp_para
334    IMPLICIT NONE
335      INTEGER :: i,j,ij,l,iq
336         
337      DO j=jj_begin,jj_end
338        DO i=ii_begin,ii_end
339          ij=(j-1)*iim+i
340          offset=offset+1
341         
342          dulon(ij,ll_begin:ll_end)=dulon_phy(offset,ll_begin:ll_end)
343          dulat(ij,ll_begin:ll_end)=dulat_phy(offset,ll_begin:ll_end)
344          dTemp(ij,ll_begin:ll_end)=dTemp_phy(offset,ll_begin:ll_end)
345          Temp(ij,ll_begin:ll_end) = Temp_phy(offset,ll_begin:ll_end)
346          dq(ij,ll_begin:ll_end,:)=dq_phy(offset,ll_begin:ll_end,:)
347          if (omp_first) dps(ij)=dps_phy(offset)
348        ENDDO
349      ENDDO
350   
351      DO l=ll_begin,ll_end
352        DO j=jj_begin,jj_end
353          DO i=ii_begin,ii_end
354            ij=(j-1)*iim+i
355            duc(ij,:,l)=dulon(ij,l)*elon_i(ij,:)+dulat(ij,l)*elat_i(ij,:)
356          ENDDO
357        ENDDO
358      ENDDO
359
360      DO l=ll_begin,ll_end
361        DO j=jj_begin,jj_end
362          DO i=ii_begin,ii_end
363            ij=(j-1)*iim+i
364            u(ij+u_right,l) = u(ij+u_right,l) + dtphy * sum( 0.5*(duc(ij,:,l) + duc(ij+t_right,:,l))*ep_e(ij+u_right,:) )
365            u(ij+u_lup,l) = u(ij+u_lup,l) + dtphy * sum( 0.5*(duc(ij,:,l) + duc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) )
366            u(ij+u_ldown,l) = u(ij+u_ldown,l) + dtphy*sum( 0.5*(duc(ij,:,l) + duc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) )
367          ENDDO
368        ENDDO
369      ENDDO         
370
371      DO l=ll_begin,ll_end
372        DO j=jj_begin,jj_end
373          DO i=ii_begin,ii_end
374            ij=(j-1)*iim+i
375            Temp(ij,l)=Temp(ij,l)+ dtphy * dTemp(ij,l)
376          ENDDO
377        ENDDO
378      ENDDO         
379     
380      DO iq=1,nqtot
381        DO l=ll_begin,ll_end
382          DO j=jj_begin,jj_end
383            DO i=ii_begin,ii_end
384              ij=(j-1)*iim+i
385              q(ij,l,iq)=q(ij,l,iq)+ dtphy * dq(ij,l,iq)
386            ENDDO
387          ENDDO
388        ENDDO 
389      ENDDO
390
391!$OMP BARRIER
392     
393     IF (omp_first) THEN
394       DO j=jj_begin,jj_end
395         DO i=ii_begin,ii_end
396           ij=(j-1)*iim+i
397           ps(ij)=ps(ij)+ dtphy * dps(ij)
398          ENDDO
399       ENDDO
400     ENDIF
401
402!     CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
403
404! compute pression
405!$OMP BARRIER
406      DO    l    = ll_begin,ll_endp1
407        DO j=jj_begin,jj_end
408          DO i=ii_begin,ii_end
409            ij=(j-1)*iim+i
410            p(ij,l) = ap(l) + bp(l) * ps(ij)
411          ENDDO
412        ENDDO
413      ENDDO
414
415!$OMP BARRIER
416
417! compute exner
418       
419       IF (omp_first) THEN
420         DO j=jj_begin,jj_end
421            DO i=ii_begin,ii_end
422               ij=(j-1)*iim+i
423               pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
424            ENDDO
425         ENDDO
426       ENDIF
427
428       ! 3D : pk
429       DO l = ll_begin,ll_end
430          DO j=jj_begin,jj_end
431             DO i=ii_begin,ii_end
432                ij=(j-1)*iim+i
433                pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
434             ENDDO
435          ENDDO
436       ENDDO
437
438!$OMP BARRIER
439
440!   compute theta, temperature and pression at layer
441    DO    l    = ll_begin, ll_end
442      DO j=jj_begin,jj_end
443        DO i=ii_begin,ii_end
444          ij=(j-1)*iim+i
445          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / (pk(ij,l) / cpp )
446        ENDDO
447      ENDDO
448    ENDDO
449   
450    END SUBROUTINE grid_physics_to_icosa
451   
452   
453    SUBROUTINE grid_icosa_to_physics
454    USE pression_mod
455    USE exner_mod
456    USE theta2theta_rhodz_mod
457    USE geopotential_mod
458    USE wind_mod
459    USE omp_para
460    IMPLICIT NONE
461   
462    REAL(rstd) :: uc(3)
463    INTEGER :: i,j,ij,l
464   
465
466! compute pression
467
468      DO    l    = ll_begin,ll_endp1
469        DO j=jj_begin,jj_end
470          DO i=ii_begin,ii_end
471            ij=(j-1)*iim+i
472            p(ij,l) = ap(l) + bp(l) * ps(ij)
473          ENDDO
474        ENDDO
475      ENDDO
476
477!$OMP BARRIER
478
479! compute exner
480       
481       IF (omp_first) THEN
482         DO j=jj_begin,jj_end
483            DO i=ii_begin,ii_end
484               ij=(j-1)*iim+i
485               pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
486            ENDDO
487         ENDDO
488       ENDIF
489
490       ! 3D : pk
491       DO l = ll_begin,ll_end
492          DO j=jj_begin,jj_end
493             DO i=ii_begin,ii_end
494                ij=(j-1)*iim+i
495                pk(ij,l) = cpp * ((.5/preff)*(p(ij,l)+p(ij,l+1))) ** kappa
496             ENDDO
497          ENDDO
498       ENDDO
499
500!$OMP BARRIER
501
502!   compute theta, temperature and pression at layer
503    DO    l    = ll_begin, ll_end
504      DO j=jj_begin,jj_end
505        DO i=ii_begin,ii_end
506          ij=(j-1)*iim+i
507          theta(ij,l) = theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g)
508          Temp(ij,l) = theta(ij,l) * pk(ij,l) / cpp
509          p_layer(ij,l)=preff*(pk(ij,l)/cpp)**(1./kappa) 
510        ENDDO
511      ENDDO
512    ENDDO
513
514
515!!! Compute geopotential
516       
517  ! for first layer
518  IF (omp_first) THEN
519    DO j=jj_begin,jj_end
520      DO i=ii_begin,ii_end
521        ij=(j-1)*iim+i
522        phi( ij,1 ) = phis( ij ) + theta(ij,1) * ( pks(ij) - pk(ij,1) )
523      ENDDO
524    ENDDO
525  ENDIF
526!!-> implicit flush on phi(:,1)
527         
528  ! for other layers
529   DO l = ll_beginp1, ll_end
530     DO j=jj_begin,jj_end
531       DO i=ii_begin,ii_end
532         ij=(j-1)*iim+i
533         phi(ij,l) =  0.5 * ( theta(ij,l)  + theta(ij,l-1) )  & 
534                          * (  pk(ij,l-1) -  pk(ij,l)    )
535       ENDDO
536     ENDDO
537   ENDDO       
538
539!$OMP BARRIER
540
541   DO l = 2, llm
542     DO j=jj_begin,jj_end
543! ---> Bug compilo intel ici en openmp
544! ---> Couper la boucle
545       if (j==jj_end+1) PRINT*,"this message must not be printed"
546       DO i=ii_begin,ii_end
547         ij=(j-1)*iim+i
548         phi(ij,l) = phi(ij,l)+ phi(ij,l-1)
549       ENDDO
550     ENDDO
551   ENDDO
552! --> IMPLICIT FLUSH on phi
553
554
555
556! compute wind centered lon lat compound
557    DO l=ll_begin,ll_end
558      DO j=jj_begin,jj_end
559        DO i=ii_begin,ii_end
560          ij=(j-1)*iim+i
561          uc(:)=1/Ai(ij)*                                                                                                &
562                        ( ne(ij,right)*u(ij+u_right,l)*le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_v(ij+z_rup,:))/2-centroid(ij,:))  &
563                         + ne(ij,rup)*u(ij+u_rup,l)*le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_v(ij+z_up,:))/2-centroid(ij,:))          &
564                         + ne(ij,lup)*u(ij+u_lup,l)*le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_v(ij+z_lup,:))/2-centroid(ij,:))          &
565                         + ne(ij,left)*u(ij+u_left,l)*le(ij+u_left)*((xyz_v(ij+z_lup,:)+xyz_v(ij+z_ldown,:))/2-centroid(ij,:))    &
566                         + ne(ij,ldown)*u(ij+u_ldown,l)*le(ij+u_ldown)*((xyz_v(ij+z_ldown,:)+xyz_v(ij+z_down,:))/2-centroid(ij,:))&
567                         + ne(ij,rdown)*u(ij+u_rdown,l)*le(ij+u_rdown)*((xyz_v(ij+z_down,:)+xyz_v(ij+z_rdown,:))/2-centroid(ij,:)))
568          ulon(ij,l)=sum(uc(:)*elon_i(ij,:))
569          ulat(ij,l)=sum(uc(:)*elat_i(ij,:)) 
570        ENDDO
571      ENDDO
572    ENDDO
573
574!$OMP BARRIER
575
576
577     
578      DO j=jj_begin,jj_end
579        DO i=ii_begin,ii_end
580          ij=(j-1)*iim+i
581          offset=offset+1
582
583          IF (omp_first) ps_phy(offset) = ps(ij)
584          p_phy(offset,ll_begin:ll_endp1) = p(ij,ll_begin:ll_endp1)
585          p_layer_phy(offset,ll_begin:ll_end) = p_layer(ij,ll_begin:ll_end)
586          Temp_phy(offset,ll_begin:ll_end) = Temp(ij,ll_begin:ll_end)
587          IF (omp_first) phis_phy(offset) = phis(ij)
588          phi_phy(offset,ll_begin:ll_end) = phi(ij,ll_begin:ll_end)-phis(ij)
589          ulon_phy(offset,ll_begin:ll_end) = ulon(ij,ll_begin:ll_end)
590          ulat_phy(offset,ll_begin:ll_end) = ulat(ij,ll_begin:ll_end)
591          q_phy(offset,ll_begin:ll_end,:) = q(ij,ll_begin:ll_end,:)
592          wflux_phy(offset,ll_begin:ll_end) = wflux(ij,ll_begin:ll_end)
593        ENDDO
594      ENDDO
595     
596     END SUBROUTINE grid_icosa_to_physics
597
598  END SUBROUTINE physics
599 
600 
601END MODULE physics_lmdz_generic_mod
602   
603 
Note: See TracBrowser for help on using the repository browser.