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

Last change on this file since 268 was 260, checked in by ymipsl, 10 years ago

Implement restartability for dynamico

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